home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / UNIXTOOL / GNU / PERL / PERL5SRC.ZIP / !Perl / c / op < prev    next >
Text File  |  1995-03-13  |  85KB  |  3,984 lines
  1. /*    op.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "You see: Mr. Drogo, he married poor Miss Primula Brandybuck.  She was
  12.  * our Mr. Bilbo's first cousin on the mother's side (her mother being the
  13.  * youngest of the Old Took's daughters); and Mr. Drogo was his second
  14.  * cousin.  So Mr. Frodo is his first *and* second cousin, once removed
  15.  * either way, as the saying is, if you follow me."  --the Gaffer
  16.  */
  17.  
  18. #include "EXTERN.h"
  19. #include "perl.h"
  20.  
  21. static I32 list_assignment _((OP *op));
  22. static OP *bad_type _((I32 n, char *t, OP *op, OP *kid));
  23. static OP *modkids _((OP *op, I32 type));
  24. static OP *no_fh_allowed _((OP *op));
  25. static OP *scalarboolean _((OP *op));
  26. static OP *too_few_arguments _((OP *op));
  27. static OP *too_many_arguments _((OP *op));
  28. static void null _((OP* op));
  29. static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, I32 seq,
  30.     CV* startcv, I32 cx_ix));
  31.  
  32. static OP *
  33. no_fh_allowed(op)
  34. OP *op;
  35. {
  36.     sprintf(tokenbuf,"Missing comma after first argument to %s function",
  37.     op_name[op->op_type]);
  38.     yyerror(tokenbuf);
  39.     return op;
  40. }
  41.  
  42. static OP *
  43. too_few_arguments(op)
  44. OP *op;
  45. {
  46.     sprintf(tokenbuf,"Not enough arguments for %s", op_name[op->op_type]);
  47.     yyerror(tokenbuf);
  48.     return op;
  49. }
  50.  
  51. static OP *
  52. too_many_arguments(op)
  53. OP *op;
  54. {
  55.     sprintf(tokenbuf,"Too many arguments for %s", op_name[op->op_type]);
  56.     yyerror(tokenbuf);
  57.     return op;
  58. }
  59.  
  60. static OP *
  61. bad_type(n, t, op, kid)
  62. I32 n;
  63. char *t;
  64. OP *op;
  65. OP *kid;
  66. {
  67.     sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)",
  68.     (int) n, op_name[op->op_type], t, op_name[kid->op_type]);
  69.     yyerror(tokenbuf);
  70.     return op;
  71. }
  72.  
  73. void
  74. assertref(op)
  75. OP *op;
  76. {
  77.     int type = op->op_type;
  78.     if (type != OP_AELEM && type != OP_HELEM) {
  79.     sprintf(tokenbuf, "Can't use subscript on %s",
  80.         op_name[type]);
  81.     yyerror(tokenbuf);
  82.     if (type == OP_RV2HV || type == OP_ENTERSUB)
  83.         warn("(Did you mean $ or @ instead of %c?)\n",
  84.         type == OP_RV2HV ? '%' : '&');
  85.     }
  86. }
  87.  
  88. /* "register" allocation */
  89.  
  90. PADOFFSET
  91. pad_allocmy(name)
  92. char *name;
  93. {
  94.     PADOFFSET off;
  95.     SV *sv;
  96.  
  97.     if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) {
  98.     if (!isprint(name[1]))
  99.         sprintf(name+1, "^%c", name[1] ^ 64); /* XXX is tokenbuf, really */
  100.     croak("Can't use global %s in \"my\"",name);
  101.     }
  102.     off = pad_alloc(OP_PADSV, SVs_PADMY);
  103.     sv = NEWSV(1102,0);
  104.     sv_upgrade(sv, SVt_PVNV);
  105.     sv_setpv(sv, name);
  106.     av_store(comppad_name, off, sv);
  107.     SvNVX(sv) = (double)999999999;
  108.     SvIVX(sv) = 0;            /* Not yet introduced--see newSTATEOP */
  109.     if (!min_intro_pending)
  110.     min_intro_pending = off;
  111.     max_intro_pending = off;
  112.     if (*name == '@')
  113.     av_store(comppad, off, (SV*)newAV());
  114.     else if (*name == '%')
  115.     av_store(comppad, off, (SV*)newHV());
  116.     SvPADMY_on(curpad[off]);
  117.     return off;
  118. }
  119.  
  120. static PADOFFSET
  121. pad_findlex(name, newoff, seq, startcv, cx_ix)
  122. char *name;
  123. PADOFFSET newoff;
  124. I32 seq;
  125. CV* startcv;
  126. I32 cx_ix;
  127. {
  128.     CV *cv;
  129.     I32 off;
  130.     SV *sv;
  131.     register I32 i;
  132.     register CONTEXT *cx;
  133.     int saweval;
  134.  
  135.     for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
  136.     AV* curlist = CvPADLIST(cv);
  137.     SV** svp = av_fetch(curlist, 0, FALSE);
  138.     AV *curname;
  139.     if (!svp || *svp == &sv_undef)
  140.         break;
  141.     curname = (AV*)*svp;
  142.     svp = AvARRAY(curname);
  143.     for (off = AvFILL(curname); off > 0; off--) {
  144.         if ((sv = svp[off]) &&
  145.         sv != &sv_undef &&
  146.         seq <= SvIVX(sv) &&
  147.         seq > (I32)SvNVX(sv) &&
  148.         strEQ(SvPVX(sv), name))
  149.         {
  150.         I32 depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1;
  151.         AV *oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
  152.         SV *oldsv = *av_fetch(oldpad, off, TRUE);
  153.         if (!newoff) {        /* Not a mere clone operation. */
  154.             SV *sv = NEWSV(1103,0);
  155.             newoff = pad_alloc(OP_PADSV, SVs_PADMY);
  156.             sv_upgrade(sv, SVt_PVNV);
  157.             sv_setpv(sv, name);
  158.             av_store(comppad_name, newoff, sv);
  159.             SvNVX(sv) = (double)curcop->cop_seq;
  160.             SvIVX(sv) = 999999999;    /* A ref, intro immediately */
  161.             SvFLAGS(sv) |= SVf_FAKE;
  162.         }
  163.         av_store(comppad, newoff, SvREFCNT_inc(oldsv));
  164.         SvFLAGS(compcv) |= SVpcv_CLONE;
  165.         return newoff;
  166.         }
  167.     }
  168.     }
  169.  
  170.     /* Nothing in current lexical context--try eval's context, if any.
  171.      * This is necessary to let the perldb get at lexically scoped variables.
  172.      * XXX This will also probably interact badly with eval tree caching.
  173.      */
  174.  
  175.     saweval = 0;
  176.     for (i = cx_ix; i >= 0; i--) {
  177.     cx = &cxstack[i];
  178.     switch (cx->cx_type) {
  179.     default:
  180.         if (i == 0 && saweval) {
  181.         seq = cxstack[saweval].blk_oldcop->cop_seq;
  182.         return pad_findlex(name, newoff, seq, main_cv, 0);
  183.         }
  184.         break;
  185.     case CXt_EVAL:
  186.         if (cx->blk_eval.old_op_type != OP_ENTEREVAL)
  187.         return 0;    /* require must have its own scope */
  188.         saweval = i;
  189.         break;
  190.     case CXt_SUB:
  191.         if (!saweval)
  192.         return 0;
  193.         cv = cx->blk_sub.cv;
  194.         if (debstash && CvSTASH(cv) == debstash) {    /* ignore DB'* scope */
  195.         saweval = i;    /* so we know where we were called from */
  196.         continue;
  197.         }
  198.         seq = cxstack[saweval].blk_oldcop->cop_seq;
  199.         return pad_findlex(name, newoff, seq, cv, i-1);
  200.     }
  201.     }
  202.  
  203.     return 0;
  204. }
  205.  
  206. PADOFFSET
  207. pad_findmy(name)
  208. char *name;
  209. {
  210.     I32 off;
  211.     SV *sv;
  212.     SV **svp = AvARRAY(comppad_name);
  213.     I32 seq = cop_seqmax;
  214.  
  215.     /* The one we're looking for is probably just before comppad_name_fill. */
  216.     for (off = comppad_name_fill; off > 0; off--) {
  217.     if ((sv = svp[off]) &&
  218.         sv != &sv_undef &&
  219.         seq <= SvIVX(sv) &&
  220.         seq > (I32)SvNVX(sv) &&
  221.         strEQ(SvPVX(sv), name))
  222.     {
  223.         return (PADOFFSET)off;
  224.     }
  225.     }
  226.  
  227.     /* See if it's in a nested scope */
  228.     off = pad_findlex(name, 0, seq, CvOUTSIDE(compcv), cxstack_ix);
  229.     if (off)
  230.     return off;
  231.  
  232.     return 0;
  233. }
  234.  
  235. void
  236. pad_leavemy(fill)
  237. I32 fill;
  238. {
  239.     I32 off;
  240.     SV **svp = AvARRAY(comppad_name);
  241.     SV *sv;
  242.     if (min_intro_pending && fill < min_intro_pending) {
  243.     for (off = max_intro_pending; off >= min_intro_pending; off--) {
  244.         if ((sv = svp[off]) && sv != &sv_undef)
  245.         warn("%s never introduced", SvPVX(sv));
  246.     }
  247.     }
  248.     /* "Deintroduce" my variables that are leaving with this scope. */
  249.     for (off = AvFILL(comppad_name); off > fill; off--) {
  250.     if ((sv = svp[off]) && sv != &sv_undef && SvIVX(sv) == 999999999)
  251.         SvIVX(sv) = cop_seqmax;
  252.     }
  253. }
  254.  
  255. PADOFFSET
  256. pad_alloc(optype,tmptype)    
  257. I32 optype;
  258. U32 tmptype;
  259. {
  260.     SV *sv;
  261.     I32 retval;
  262.  
  263.     if (AvARRAY(comppad) != curpad)
  264.     croak("panic: pad_alloc");
  265.     if (pad_reset_pending)
  266.     pad_reset();
  267.     if (tmptype & SVs_PADMY) {
  268.     do {
  269.         sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE);
  270.     } while (SvPADBUSY(sv));        /* need a fresh one */
  271.     retval = AvFILL(comppad);
  272.     }
  273.     else {
  274.     do {
  275.         sv = *av_fetch(comppad, ++padix, TRUE);
  276.     } while (SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY));
  277.     retval = padix;
  278.     }
  279.     SvFLAGS(sv) |= tmptype;
  280.     curpad = AvARRAY(comppad);
  281.     DEBUG_X(fprintf(stderr, "Pad alloc %ld for %s\n", (long) retval, op_name[optype]));
  282.     return (PADOFFSET)retval;
  283. }
  284.  
  285. SV *
  286. #ifndef CAN_PROTOTYPE
  287. pad_sv(po)
  288. PADOFFSET po;
  289. #else
  290. pad_sv(PADOFFSET po)
  291. #endif /* CAN_PROTOTYPE */
  292. {
  293.     if (!po)
  294.     croak("panic: pad_sv po");
  295.     DEBUG_X(fprintf(stderr, "Pad sv %d\n", po));
  296.     return curpad[po];        /* eventually we'll turn this into a macro */
  297. }
  298.  
  299. void
  300. #ifndef CAN_PROTOTYPE
  301. pad_free(po)
  302. PADOFFSET po;
  303. #else
  304. pad_free(PADOFFSET po)
  305. #endif /* CAN_PROTOTYPE */
  306. {
  307.     if (!curpad)
  308.     return;
  309.     if (AvARRAY(comppad) != curpad)
  310.     croak("panic: pad_free curpad");
  311.     if (!po)
  312.     croak("panic: pad_free po");
  313.     DEBUG_X(fprintf(stderr, "Pad free %d\n", po));
  314.     if (curpad[po] && curpad[po] != &sv_undef)
  315.     SvPADTMP_off(curpad[po]);
  316.     if ((I32)po < padix)
  317.     padix = po - 1;
  318. }
  319.  
  320. void
  321. #ifndef CAN_PROTOTYPE
  322. pad_swipe(po)
  323. PADOFFSET po;
  324. #else
  325. pad_swipe(PADOFFSET po)
  326. #endif /* CAN_PROTOTYPE */
  327. {
  328.     if (AvARRAY(comppad) != curpad)
  329.     croak("panic: pad_swipe curpad");
  330.     if (!po)
  331.     croak("panic: pad_swipe po");
  332.     DEBUG_X(fprintf(stderr, "Pad swipe %d\n", po));
  333.     SvPADTMP_off(curpad[po]);
  334.     curpad[po] = NEWSV(1107,0);
  335.     SvPADTMP_on(curpad[po]);
  336.     if ((I32)po < padix)
  337.     padix = po - 1;
  338. }
  339.  
  340. void
  341. pad_reset()
  342. {
  343.     register I32 po;
  344.  
  345.     if (AvARRAY(comppad) != curpad)
  346.     croak("panic: pad_reset curpad");
  347.     DEBUG_X(fprintf(stderr, "Pad reset\n"));
  348.     if (!tainting) {    /* Can't mix tainted and non-tainted temporaries. */
  349.     for (po = AvMAX(comppad); po > padix_floor; po--) {
  350.         if (curpad[po] && curpad[po] != &sv_undef)
  351.         SvPADTMP_off(curpad[po]);
  352.     }
  353.     padix = padix_floor;
  354.     }
  355.     pad_reset_pending = FALSE;
  356. }
  357.  
  358. /* Destructor */
  359.  
  360. void
  361. op_free(op)
  362. OP *op;
  363. {
  364.     register OP *kid, *nextkid;
  365.  
  366.     if (!op)
  367.     return;
  368.  
  369.     if (op->op_flags & OPf_KIDS) {
  370.     for (kid = cUNOP->op_first; kid; kid = nextkid) {
  371.         nextkid = kid->op_sibling; /* Get before next freeing kid */
  372.         op_free(kid);
  373.     }
  374.     }
  375.  
  376.     switch (op->op_type) {
  377.     case OP_NULL:
  378.     op->op_targ = 0;    /* Was holding old type, if any. */
  379.     break;
  380.     case OP_ENTEREVAL:
  381.     op->op_targ = 0;    /* Was holding hints. */
  382.     break;
  383.     case OP_GVSV:
  384.     case OP_GV:
  385.     SvREFCNT_dec(cGVOP->op_gv);
  386.     break;
  387.     case OP_NEXTSTATE:
  388.     case OP_DBSTATE:
  389.     SvREFCNT_dec(cCOP->cop_filegv);
  390.     break;
  391.     case OP_CONST:
  392.     SvREFCNT_dec(cSVOP->op_sv);
  393.     break;
  394.     case OP_GOTO:
  395.     case OP_NEXT:
  396.     case OP_LAST:
  397.     case OP_REDO:
  398.     if (op->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
  399.         break;
  400.     /* FALL THROUGH */
  401.     case OP_TRANS:
  402.     Safefree(cPVOP->op_pv);
  403.     break;
  404.     case OP_SUBST:
  405.     op_free(cPMOP->op_pmreplroot);
  406.     /* FALL THROUGH */
  407.     case OP_PUSHRE:
  408.     case OP_MATCH:
  409.     regfree(cPMOP->op_pmregexp);
  410.     SvREFCNT_dec(cPMOP->op_pmshort);
  411.     break;
  412.     default:
  413.     break;
  414.     }
  415.  
  416.     if (op->op_targ > 0)
  417.     pad_free(op->op_targ);
  418.  
  419.     Safefree(op);
  420. }
  421.  
  422. static void
  423. null(op)
  424. OP* op;
  425. {
  426.     if (op->op_type != OP_NULL && op->op_targ > 0)
  427.     pad_free(op->op_targ);
  428.     op->op_targ = op->op_type;
  429.     op->op_type = OP_NULL;
  430.     op->op_ppaddr = ppaddr[OP_NULL];
  431. }
  432.  
  433. /* Contextualizers */
  434.  
  435. #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
  436.  
  437. OP *
  438. linklist(op)
  439. OP *op;
  440. {
  441.     register OP *kid;
  442.  
  443.     if (op->op_next)
  444.     return op->op_next;
  445.  
  446.     /* establish postfix order */
  447.     if (cUNOP->op_first) {
  448.     op->op_next = LINKLIST(cUNOP->op_first);
  449.     for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
  450.         if (kid->op_sibling)
  451.         kid->op_next = LINKLIST(kid->op_sibling);
  452.         else
  453.         kid->op_next = op;
  454.     }
  455.     }
  456.     else
  457.     op->op_next = op;
  458.  
  459.     return op->op_next;
  460. }
  461.  
  462. OP *
  463. scalarkids(op)
  464. OP *op;
  465. {
  466.     OP *kid;
  467.     if (op && op->op_flags & OPf_KIDS) {
  468.     for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
  469.         scalar(kid);
  470.     }
  471.     return op;
  472. }
  473.  
  474. static OP *
  475. scalarboolean(op)
  476. OP *op;
  477. {
  478.     if (dowarn &&
  479.     op->op_type == OP_SASSIGN && cBINOP->op_first->op_type == OP_CONST) {
  480.     line_t oldline = curcop->cop_line;
  481.  
  482.     if (copline != NOLINE)
  483.         curcop->cop_line = copline;
  484.     warn("Found = in conditional, should be ==");
  485.     curcop->cop_line = oldline;
  486.     }
  487.     return scalar(op);
  488. }
  489.  
  490. OP *
  491. scalar(op)
  492. OP *op;
  493. {
  494.     OP *kid;
  495.  
  496.     /* assumes no premature commitment */
  497.     if (!op || (op->op_flags & OPf_KNOW) || error_count)
  498.     return op;
  499.  
  500.     op->op_flags &= ~OPf_LIST;
  501.     op->op_flags |= OPf_KNOW;
  502.  
  503.     switch (op->op_type) {
  504.     case OP_REPEAT:
  505.     scalar(cBINOP->op_first);
  506.     break;
  507.     case OP_OR:
  508.     case OP_AND:
  509.     case OP_COND_EXPR:
  510.     for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
  511.         scalar(kid);
  512.     break;
  513.     case OP_SPLIT:
  514.     if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) {
  515.         if (!kPMOP->op_pmreplroot)
  516.         deprecate("implicit split to @_");
  517.     }
  518.     /* FALL THROUGH */
  519.     case OP_MATCH:
  520.     case OP_SUBST:
  521.     case OP_NULL:
  522.     default:
  523.     if (op->op_flags & OPf_KIDS) {
  524.         for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
  525.         scalar(kid);
  526.     }
  527.     break;
  528.     case OP_LEAVE:
  529.     case OP_LEAVETRY:
  530.     scalar(cLISTOP->op_first);
  531.     /* FALL THROUGH */
  532.     case OP_SCOPE:
  533.     case OP_LINESEQ:
  534.     case OP_LIST:
  535.     for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
  536.         if (kid->op_sibling)
  537.         scalarvoid(kid);
  538.         else
  539.         scalar(kid);
  540.     }
  541.     curcop = &compiling;
  542.     break;
  543.     }
  544.     return op;
  545. }
  546.  
  547. OP *
  548. scalarvoid(op)
  549. OP *op;
  550. {
  551.     OP *kid;
  552.     char* useless = 0;
  553.     SV* sv;
  554.  
  555.     if (!op || error_count)
  556.     return op;
  557.     if (op->op_flags & OPf_LIST)
  558.     return op;
  559.  
  560.     op->op_flags |= OPf_KNOW;
  561.  
  562.     switch (op->op_type) {
  563.     default:
  564.     if (!(opargs[op->op_type] & OA_FOLDCONST))
  565.         break;
  566.     if (op->op_flags & OPf_STACKED)
  567.         break;
  568.     /* FALL THROUGH */
  569.     case OP_GVSV:
  570.     case OP_WANTARRAY:
  571.     case OP_GV:
  572.     case OP_PADSV:
  573.     case OP_PADAV:
  574.     case OP_PADHV:
  575.     case OP_PADANY:
  576.     case OP_AV2ARYLEN:
  577.     case OP_SV2LEN:
  578.     case OP_REF:
  579.     case OP_REFGEN:
  580.     case OP_SREFGEN:
  581.     case OP_DEFINED:
  582.     case OP_HEX:
  583.     case OP_OCT:
  584.     case OP_LENGTH:
  585.     case OP_SUBSTR:
  586.     case OP_VEC:
  587.     case OP_INDEX:
  588.     case OP_RINDEX:
  589.     case OP_SPRINTF:
  590.     case OP_AELEM:
  591.     case OP_AELEMFAST:
  592.     case OP_ASLICE:
  593.     case OP_VALUES:
  594.     case OP_KEYS:
  595.     case OP_HELEM:
  596.     case OP_HSLICE:
  597.     case OP_UNPACK:
  598.     case OP_PACK:
  599.     case OP_JOIN:
  600.     case OP_LSLICE:
  601.     case OP_ANONLIST:
  602.     case OP_ANONHASH:
  603.     case OP_SORT:
  604.     case OP_REVERSE:
  605.     case OP_RANGE:
  606.     case OP_FLIP:
  607.     case OP_FLOP:
  608.     case OP_CALLER:
  609.     case OP_FILENO:
  610.     case OP_EOF:
  611.     case OP_TELL:
  612.     case OP_GETSOCKNAME:
  613.     case OP_GETPEERNAME:
  614.     case OP_READLINK:
  615.     case OP_TELLDIR:
  616.     case OP_GETPPID:
  617.     case OP_GETPGRP:
  618.     case OP_GETPRIORITY:
  619.     case OP_TIME:
  620.     case OP_TMS:
  621.     case OP_LOCALTIME:
  622.     case OP_GMTIME:
  623.     case OP_GHBYNAME:
  624.     case OP_GHBYADDR:
  625.     case OP_GHOSTENT:
  626.     case OP_GNBYNAME:
  627.     case OP_GNBYADDR:
  628.     case OP_GNETENT:
  629.     case OP_GPBYNAME:
  630.     case OP_GPBYNUMBER:
  631.     case OP_GPROTOENT:
  632.     case OP_GSBYNAME:
  633.     case OP_GSBYPORT:
  634.     case OP_GSERVENT:
  635.     case OP_GPWNAM:
  636.     case OP_GPWUID:
  637.     case OP_GGRNAM:
  638.     case OP_GGRGID:
  639.     case OP_GETLOGIN:
  640.     if (!(op->op_private & OPpLVAL_INTRO))
  641.         useless = op_name[op->op_type];
  642.     break;
  643.  
  644.     case OP_RV2GV:
  645.     case OP_RV2SV:
  646.     case OP_RV2AV:
  647.     case OP_RV2HV:
  648.     if (!(op->op_private & OPpLVAL_INTRO) &&
  649.         (!op->op_sibling || op->op_sibling->op_type != OP_READLINE))
  650.         useless = "a variable";
  651.     break;
  652.  
  653.     case OP_NEXTSTATE:
  654.     case OP_DBSTATE:
  655.     curcop = ((COP*)op);        /* for warning below */
  656.     break;
  657.  
  658.     case OP_CONST:
  659.     sv = cSVOP->op_sv;
  660.     if (dowarn) {
  661.         useless = "a constant";
  662.         if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
  663.         useless = 0;
  664.         else if (SvPOK(sv)) {
  665.         if (strnEQ(SvPVX(sv), "di", 2) ||
  666.             strnEQ(SvPVX(sv), "ds", 2) ||
  667.             strnEQ(SvPVX(sv), "ig", 2))
  668.             useless = 0;
  669.         }
  670.     }
  671.     null(op);        /* don't execute a constant */
  672.     SvREFCNT_dec(sv);    /* don't even remember it */
  673.     break;
  674.  
  675.     case OP_POSTINC:
  676.     op->op_type = OP_PREINC;        /* pre-increment is faster */
  677.     op->op_ppaddr = ppaddr[OP_PREINC];
  678.     break;
  679.  
  680.     case OP_POSTDEC:
  681.     op->op_type = OP_PREDEC;        /* pre-decrement is faster */
  682.     op->op_ppaddr = ppaddr[OP_PREDEC];
  683.     break;
  684.  
  685.     case OP_REPEAT:
  686.     scalarvoid(cBINOP->op_first);
  687.     useless = op_name[op->op_type];
  688.     break;
  689.  
  690.     case OP_OR:
  691.     case OP_AND:
  692.     case OP_COND_EXPR:
  693.     for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
  694.         scalarvoid(kid);
  695.     break;
  696.     case OP_NULL:
  697.     if (op->op_targ == OP_NEXTSTATE || op->op_targ == OP_DBSTATE)
  698.         curcop = ((COP*)op);        /* for warning below */
  699.     if (op->op_flags & OPf_STACKED)
  700.         break;
  701.     case OP_ENTERTRY:
  702.     case OP_ENTER:
  703.     case OP_SCALAR:
  704.     if (!(op->op_flags & OPf_KIDS))
  705.         break;
  706.     case OP_SCOPE:
  707.     case OP_LEAVE:
  708.     case OP_LEAVETRY:
  709.     case OP_LEAVELOOP:
  710.     op->op_private |= OPpLEAVE_VOID;
  711.     case OP_LINESEQ:
  712.     case OP_LIST:
  713.     for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
  714.         scalarvoid(kid);
  715.     break;
  716.     case OP_SPLIT:
  717.     if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) {
  718.         if (!kPMOP->op_pmreplroot)
  719.         deprecate("implicit split to @_");
  720.     }
  721.     break;
  722.     case OP_DELETE:
  723.     op->op_private |= OPpLEAVE_VOID;
  724.     break;
  725.     }
  726.     if (useless && dowarn)
  727.     warn("Useless use of %s in void context", useless);
  728.     return op;
  729. }
  730.  
  731. OP *
  732. listkids(op)
  733. OP *op;
  734. {
  735.     OP *kid;
  736.     if (op && op->op_flags & OPf_KIDS) {
  737.     for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
  738.         list(kid);
  739.     }
  740.     return op;
  741. }
  742.  
  743. OP *
  744. list(op)
  745. OP *op;
  746. {
  747.     OP *kid;
  748.  
  749.     /* assumes no premature commitment */
  750.     if (!op || (op->op_flags & OPf_KNOW) || error_count)
  751.     return op;
  752.  
  753.     op->op_flags |= (OPf_KNOW | OPf_LIST);
  754.  
  755.     switch (op->op_type) {
  756.     case OP_FLOP:
  757.     case OP_REPEAT:
  758.     list(cBINOP->op_first);
  759.     break;
  760.     case OP_OR:
  761.     case OP_AND:
  762.     case OP_COND_EXPR:
  763.     for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
  764.         list(kid);
  765.     break;
  766.     default:
  767.     case OP_MATCH:
  768.     case OP_SUBST:
  769.     case OP_NULL:
  770.     if (!(op->op_flags & OPf_KIDS))
  771.         break;
  772.     if (!op->op_next && cUNOP->op_first->op_type == OP_FLOP) {
  773.         list(cBINOP->op_first);
  774.         return gen_constant_list(op);
  775.     }
  776.     case OP_LIST:
  777.     listkids(op);
  778.     break;
  779.     case OP_LEAVE:
  780.     case OP_LEAVETRY:
  781.     list(cLISTOP->op_first);
  782.     /* FALL THROUGH */
  783.     case OP_SCOPE:
  784.     case OP_LINESEQ:
  785.     for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
  786.         if (kid->op_sibling)
  787.         scalarvoid(kid);
  788.         else
  789.         list(kid);
  790.     }
  791.     curcop = &compiling;
  792.     break;
  793.     }
  794.     return op;
  795. }
  796.  
  797. OP *
  798. scalarseq(op)
  799. OP *op;
  800. {
  801.     OP *kid;
  802.  
  803.     if (op) {
  804.     if (op->op_type == OP_LINESEQ ||
  805.          op->op_type == OP_SCOPE ||
  806.          op->op_type == OP_LEAVE ||
  807.          op->op_type == OP_LEAVETRY)
  808.     {
  809.         for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
  810.         if (kid->op_sibling) {
  811.             scalarvoid(kid);
  812.         }
  813.         }
  814.         curcop = &compiling;
  815.     }
  816.     op->op_flags &= ~OPf_PARENS;
  817.     if (hints & HINT_BLOCK_SCOPE)
  818.         op->op_flags |= OPf_PARENS;
  819.     }
  820.     else
  821.     op = newOP(OP_STUB, 0);
  822.     return op;
  823. }
  824.  
  825. static OP *
  826. modkids(op, type)
  827. OP *op;
  828. I32 type;
  829. {
  830.     OP *kid;
  831.     if (op && op->op_flags & OPf_KIDS) {
  832.     for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
  833.         mod(kid, type);
  834.     }
  835.     return op;
  836. }
  837.  
  838. static I32 modcount;
  839.  
  840. OP *
  841. mod(op, type)
  842. OP *op;
  843. I32 type;
  844. {
  845.     OP *kid;
  846.     SV *sv;
  847.     char mtype;
  848.  
  849.     if (!op || error_count)
  850.     return op;
  851.  
  852.     switch (op->op_type) {
  853.     case OP_CONST:
  854.     if (!(op->op_private & (OPpCONST_ARYBASE)))
  855.         goto nomod;
  856.     if (eval_start && eval_start->op_type == OP_CONST) {
  857.         compiling.cop_arybase = (I32)SvIV(((SVOP*)eval_start)->op_sv);
  858.         eval_start = 0;
  859.     }
  860.     else if (!type) {
  861.         SAVEI32(compiling.cop_arybase);
  862.         compiling.cop_arybase = 0;
  863.     }
  864.     else if (type == OP_REFGEN)
  865.         goto nomod;
  866.     else
  867.         croak("That use of $[ is unsupported");
  868.     break;
  869.     case OP_ENTERSUB:
  870.     if ((type == OP_UNDEF || type == OP_REFGEN) &&
  871.         !(op->op_flags & OPf_STACKED)) {
  872.         op->op_type = OP_RV2CV;        /* entersub => rv2cv */
  873.         op->op_ppaddr = ppaddr[OP_RV2CV];
  874.         assert(cUNOP->op_first->op_type == OP_NULL);
  875.         null(((LISTOP*)cUNOP->op_first)->op_first);    /* disable pushmark */
  876.         break;
  877.     }
  878.     /* FALL THROUGH */
  879.     default:
  880.       nomod:
  881.     /* grep, foreach, subcalls, refgen */
  882.     if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
  883.         break;
  884.     sprintf(tokenbuf, "Can't modify %s in %s",
  885.         op_name[op->op_type],
  886.         type ? op_name[type] : "local");
  887.     yyerror(tokenbuf);
  888.     return op;
  889.  
  890.     case OP_PREINC:
  891.     case OP_PREDEC:
  892.     case OP_POW:
  893.     case OP_MULTIPLY:
  894.     case OP_DIVIDE:
  895.     case OP_MODULO:
  896.     case OP_REPEAT:
  897.     case OP_ADD:
  898.     case OP_SUBTRACT:
  899.     case OP_CONCAT:
  900.     case OP_LEFT_SHIFT:
  901.     case OP_RIGHT_SHIFT:
  902.     case OP_BIT_AND:
  903.     case OP_BIT_XOR:
  904.     case OP_BIT_OR:
  905.     case OP_I_MULTIPLY:
  906.     case OP_I_DIVIDE:
  907.     case OP_I_MODULO:
  908.     case OP_I_ADD:
  909.     case OP_I_SUBTRACT:
  910.     if (!(op->op_flags & OPf_STACKED))
  911.         goto nomod;
  912.     modcount++;
  913.     break;
  914.     
  915.     case OP_COND_EXPR:
  916.     for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
  917.         mod(kid, type);
  918.     break;
  919.  
  920.     case OP_RV2AV:
  921.     case OP_RV2HV:
  922.     if (type == OP_REFGEN && op->op_flags & OPf_PARENS) {
  923.         modcount = 10000;
  924.         return op;        /* Treat \(@foo) like ordinary list. */
  925.     }
  926.     /* FALL THROUGH */
  927.     case OP_RV2GV:
  928.     ref(cUNOP->op_first, op->op_type);
  929.     /* FALL THROUGH */
  930.     case OP_AASSIGN:
  931.     case OP_ASLICE:
  932.     case OP_HSLICE:
  933.     case OP_NEXTSTATE:
  934.     case OP_DBSTATE:
  935.     case OP_REFGEN:
  936.     case OP_CHOMP:
  937.     modcount = 10000;
  938.     break;
  939.     case OP_RV2SV:
  940.     ref(cUNOP->op_first, op->op_type); 
  941.     /* FALL THROUGH */
  942.     case OP_UNDEF:
  943.     case OP_GV:
  944.     case OP_AV2ARYLEN:
  945.     case OP_SASSIGN:
  946.     case OP_AELEMFAST:
  947.     modcount++;
  948.     break;
  949.  
  950.     case OP_PADAV:
  951.     case OP_PADHV:
  952.     modcount = 10000;
  953.     /* FALL THROUGH */
  954.     case OP_PADSV:
  955.     modcount++;
  956.     if (!type)
  957.         croak("Can't localize lexical variable %s",
  958.         SvPV(*av_fetch(comppad_name, op->op_targ, 4), na));
  959.     break;
  960.  
  961.     case OP_PUSHMARK:
  962.     break;
  963.     
  964.     case OP_POS:
  965.     mtype = '.';
  966.     goto makelv;
  967.     case OP_VEC:
  968.     mtype = 'v';
  969.     goto makelv;
  970.     case OP_SUBSTR:
  971.     mtype = 'x';
  972.       makelv:
  973.     pad_free(op->op_targ);
  974.     op->op_targ = pad_alloc(op->op_type, SVs_PADMY);
  975.     sv = PAD_SV(op->op_targ);
  976.     sv_upgrade(sv, SVt_PVLV);
  977.     sv_magic(sv, Nullsv, mtype, Nullch, 0);
  978.     curpad[op->op_targ] = sv;
  979.     if (op->op_flags & OPf_KIDS)
  980.         mod(cBINOP->op_first, type);
  981.     break;
  982.  
  983.     case OP_AELEM:
  984.     case OP_HELEM:
  985.     ref(cBINOP->op_first, op->op_type);
  986.     modcount++;
  987.     break;
  988.  
  989.     case OP_SCOPE:
  990.     case OP_LEAVE:
  991.     case OP_ENTER:
  992.     if (op->op_flags & OPf_KIDS)
  993.         mod(cLISTOP->op_last, type);
  994.     break;
  995.  
  996.     case OP_NULL:
  997.     if (!(op->op_flags & OPf_KIDS))
  998.         break;
  999.     if (op->op_targ != OP_LIST) {
  1000.         mod(cBINOP->op_first, type);
  1001.         break;
  1002.     }
  1003.     /* FALL THROUGH */
  1004.     case OP_LIST:
  1005.     for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
  1006.         mod(kid, type);
  1007.     break;
  1008.     }
  1009.     op->op_flags |= OPf_MOD;
  1010.  
  1011.     if (type == OP_AASSIGN || type == OP_SASSIGN)
  1012.     op->op_flags |= OPf_SPECIAL|OPf_REF;
  1013.     else if (!type) {
  1014.     op->op_private |= OPpLVAL_INTRO;
  1015.     op->op_flags &= ~OPf_SPECIAL;
  1016.     }
  1017.     else if (type != OP_GREPSTART && type != OP_ENTERSUB)
  1018.     op->op_flags |= OPf_REF;
  1019.     return op;
  1020. }
  1021.  
  1022. OP *
  1023. refkids(op, type)
  1024. OP *op;
  1025. I32 type;
  1026. {
  1027.     OP *kid;
  1028.     if (op && op->op_flags & OPf_KIDS) {
  1029.     for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
  1030.         ref(kid, type);
  1031.     }
  1032.     return op;
  1033. }
  1034.  
  1035. OP *
  1036. ref(op, type)
  1037. OP *op;
  1038. I32 type;
  1039. {
  1040.     OP *kid;
  1041.  
  1042.     if (!op || error_count)
  1043.     return op;
  1044.  
  1045.     switch (op->op_type) {
  1046.     case OP_ENTERSUB:
  1047.     if ((type == OP_DEFINED) &&
  1048.         !(op->op_flags & OPf_STACKED)) {
  1049.         op->op_type = OP_RV2CV;             /* entersub => rv2cv */
  1050.         op->op_ppaddr = ppaddr[OP_RV2CV];
  1051.         assert(cUNOP->op_first->op_type == OP_NULL);
  1052.         null(((LISTOP*)cUNOP->op_first)->op_first);    /* disable pushmark */
  1053.     }
  1054.     break;
  1055.       
  1056.     case OP_COND_EXPR:
  1057.     for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
  1058.         ref(kid, type);
  1059.     break;
  1060.     case OP_RV2SV:
  1061.     ref(cUNOP->op_first, op->op_type);
  1062.     if (type == OP_RV2AV || type == OP_RV2HV) {
  1063.         op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
  1064.         op->op_flags |= OPf_MOD;
  1065.     }
  1066.     break;
  1067.       
  1068.     case OP_RV2AV:
  1069.     case OP_RV2HV:
  1070.     op->op_flags |= OPf_REF; 
  1071.     /* FALL THROUGH */
  1072.     case OP_RV2GV:
  1073.     ref(cUNOP->op_first, op->op_type);
  1074.     break;
  1075.  
  1076.     case OP_PADAV:
  1077.     case OP_PADHV:
  1078.     op->op_flags |= OPf_REF; 
  1079.     break;
  1080.       
  1081.     case OP_SCALAR:
  1082.     case OP_NULL:
  1083.     if (!(op->op_flags & OPf_KIDS))
  1084.         break;
  1085.     ref(cBINOP->op_first, type);
  1086.     break;
  1087.     case OP_AELEM:
  1088.     case OP_HELEM:
  1089.     ref(cBINOP->op_first, op->op_type);
  1090.     if (type == OP_RV2AV || type == OP_RV2HV) {
  1091.         op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
  1092.         op->op_flags |= OPf_MOD;
  1093.     }
  1094.     break;
  1095.  
  1096.     case OP_SCOPE:
  1097.     case OP_LEAVE:
  1098.     case OP_ENTER:
  1099.     case OP_LIST:
  1100.     if (!(op->op_flags & OPf_KIDS))
  1101.         break;
  1102.     ref(cLISTOP->op_last, type);
  1103.     break;
  1104.     default:
  1105.     break;
  1106.     }
  1107.     return scalar(op);
  1108.  
  1109. }
  1110.  
  1111. OP *
  1112. my(op)
  1113. OP *op;
  1114. {
  1115.     OP *kid;
  1116.     I32 type;
  1117.  
  1118.     if (!op || error_count)
  1119.     return op;
  1120.  
  1121.     type = op->op_type;
  1122.     if (type == OP_LIST) {
  1123.     for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
  1124.         my(kid);
  1125.     }
  1126.     else if (type != OP_PADSV &&
  1127.          type != OP_PADAV &&
  1128.          type != OP_PADHV &&
  1129.          type != OP_PUSHMARK)
  1130.     {
  1131.     sprintf(tokenbuf, "Can't declare %s in my", op_name[op->op_type]);
  1132.     yyerror(tokenbuf);
  1133.     return op;
  1134.     }
  1135.     op->op_flags |= OPf_MOD;
  1136.     op->op_private |= OPpLVAL_INTRO;
  1137.     return op;
  1138. }
  1139.  
  1140. OP *
  1141. sawparens(o)
  1142. OP *o;
  1143. {
  1144.     if (o)
  1145.     o->op_flags |= OPf_PARENS;
  1146.     return o;
  1147. }
  1148.  
  1149. OP *
  1150. bind_match(type, left, right)
  1151. I32 type;
  1152. OP *left;
  1153. OP *right;
  1154. {
  1155.     OP *op;
  1156.  
  1157.     if (right->op_type == OP_MATCH ||
  1158.     right->op_type == OP_SUBST ||
  1159.     right->op_type == OP_TRANS) {
  1160.     right->op_flags |= OPf_STACKED;
  1161.     if (right->op_type != OP_MATCH)
  1162.         left = mod(left, right->op_type);
  1163.     if (right->op_type == OP_TRANS)
  1164.         op = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
  1165.     else
  1166.         op = prepend_elem(right->op_type, scalar(left), right);
  1167.     if (type == OP_NOT)
  1168.         return newUNOP(OP_NOT, 0, scalar(op));
  1169.     return op;
  1170.     }
  1171.     else
  1172.     return bind_match(type, left,
  1173.         pmruntime(newPMOP(OP_MATCH, 0), right, Nullop));
  1174. }
  1175.  
  1176. OP *
  1177. invert(op)
  1178. OP *op;
  1179. {
  1180.     if (!op)
  1181.     return op;
  1182.     /* XXX need to optimize away NOT NOT here?  Or do we let optimizer do it? */
  1183.     return newUNOP(OP_NOT, OPf_SPECIAL, scalar(op));
  1184. }
  1185.  
  1186. OP *
  1187. scope(o)
  1188. OP *o;
  1189. {
  1190.     if (o) {
  1191.     if (o->op_flags & OPf_PARENS || perldb) {
  1192.         o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
  1193.         o->op_type = OP_LEAVE;
  1194.         o->op_ppaddr = ppaddr[OP_LEAVE];
  1195.     }
  1196.     else {
  1197.         if (o->op_type == OP_LINESEQ) {
  1198.         OP *kid;
  1199.         o->op_type = OP_SCOPE;
  1200.         o->op_ppaddr = ppaddr[OP_SCOPE];
  1201.         kid = ((LISTOP*)o)->op_first;
  1202.         if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
  1203.             SvREFCNT_dec(((COP*)kid)->cop_filegv);
  1204.             null(kid);
  1205.         }
  1206.         }
  1207.         else
  1208.         o = newLISTOP(OP_SCOPE, 0, o, Nullop);
  1209.     }
  1210.     }
  1211.     return o;
  1212. }
  1213.  
  1214. int
  1215. block_start()
  1216. {
  1217.     int retval = savestack_ix;
  1218.     comppad_name_fill = AvFILL(comppad_name);
  1219.     SAVEINT(min_intro_pending);
  1220.     SAVEINT(max_intro_pending);
  1221.     min_intro_pending = 0;
  1222.     SAVEINT(comppad_name_fill);
  1223.     SAVEINT(padix_floor);
  1224.     padix_floor = padix;
  1225.     pad_reset_pending = FALSE;
  1226.     SAVEINT(hints);
  1227.     hints &= ~HINT_BLOCK_SCOPE;
  1228.     return retval;
  1229. }
  1230.  
  1231. OP*
  1232. block_end(line, floor, seq)
  1233. int line;
  1234. int floor;
  1235. OP* seq;
  1236. {
  1237.     int needblockscope = hints & HINT_BLOCK_SCOPE;
  1238.     OP* retval = scalarseq(seq);
  1239.     if (copline > (line_t)line)
  1240.     copline = line;
  1241.     LEAVE_SCOPE(floor);
  1242.     pad_reset_pending = FALSE;
  1243.     if (needblockscope)
  1244.     hints |= HINT_BLOCK_SCOPE; /* propagate out */
  1245.     pad_leavemy(comppad_name_fill);
  1246.     return retval;
  1247. }
  1248.  
  1249. void
  1250. newPROG(op)
  1251. OP *op;
  1252. {
  1253.     if (in_eval) {
  1254.     eval_root = newUNOP(OP_LEAVEEVAL, 0, op);
  1255.     eval_start = linklist(eval_root);
  1256.     eval_root->op_next = 0;
  1257.     peep(eval_start);
  1258.     }
  1259.     else {
  1260.     if (!op) {
  1261.         main_start = 0;
  1262.         return;
  1263.     }
  1264.     main_root = scope(sawparens(scalarvoid(op)));
  1265.     curcop = &compiling;
  1266.     main_start = LINKLIST(main_root);
  1267.     main_root->op_next = 0;
  1268.     peep(main_start);
  1269.     main_cv = compcv;
  1270.     compcv = 0;
  1271.     }
  1272. }
  1273.  
  1274. OP *
  1275. localize(o, lex)
  1276. OP *o;
  1277. I32 lex;
  1278. {
  1279.     if (o->op_flags & OPf_PARENS)
  1280.     list(o);
  1281.     else {
  1282.     scalar(o);
  1283.     if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') {
  1284.         char *s;
  1285.         for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
  1286.         if (*s == ';' || *s == '=')
  1287.         warn("Parens missing around \"%s\" list", lex ? "my" : "local");
  1288.     }
  1289.     }
  1290.     in_my = FALSE;
  1291.     if (lex)
  1292.     return my(o);
  1293.     else
  1294.     return mod(o, OP_NULL);        /* a bit kludgey */
  1295. }
  1296.  
  1297. OP *
  1298. jmaybe(o)
  1299. OP *o;
  1300. {
  1301.     if (o->op_type == OP_LIST) {
  1302.     o = convert(OP_JOIN, 0,
  1303.         prepend_elem(OP_LIST,
  1304.             newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
  1305.             o));
  1306.     }
  1307.     return o;
  1308. }
  1309.  
  1310. OP *
  1311. fold_constants(o)
  1312. register OP *o;
  1313. {
  1314.     register OP *curop;
  1315.     I32 type = o->op_type;
  1316.     SV *sv;
  1317.  
  1318.     if (opargs[type] & OA_RETSCALAR)
  1319.     scalar(o);
  1320.     if (opargs[type] & OA_TARGET)
  1321.     o->op_targ = pad_alloc(type, SVs_PADTMP);
  1322.  
  1323.     if ((opargs[type] & OA_OTHERINT) && (hints & HINT_INTEGER))
  1324.     o->op_ppaddr = ppaddr[type = ++(o->op_type)];
  1325.  
  1326.     if (!(opargs[type] & OA_FOLDCONST))
  1327.     goto nope;
  1328.  
  1329.     if (error_count)
  1330.     goto nope;        /* Don't try to run w/ errors */
  1331.  
  1332.     for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
  1333.     if (curop->op_type != OP_CONST &&
  1334.         curop->op_type != OP_LIST &&
  1335.         curop->op_type != OP_SCALAR &&
  1336.         curop->op_type != OP_NULL &&
  1337.         curop->op_type != OP_PUSHMARK) {
  1338.         goto nope;
  1339.     }
  1340.     }
  1341.  
  1342.     curop = LINKLIST(o);
  1343.     o->op_next = 0;
  1344.     op = curop;
  1345.     run();
  1346.     sv = *(stack_sp--);
  1347.     if (o->op_targ && sv == PAD_SV(o->op_targ))    /* grab pad temp? */
  1348.     pad_swipe(o->op_targ);
  1349.     else if (SvTEMP(sv)) {            /* grab mortal temp? */
  1350.     (void)SvREFCNT_inc(sv);
  1351.     SvTEMP_off(sv);
  1352.     }
  1353.     op_free(o);
  1354.     if (type == OP_RV2GV)
  1355.     return newGVOP(OP_GV, 0, sv);
  1356.     else {
  1357.     if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) {
  1358.         IV iv = SvIV(sv);
  1359.         if ((double)iv == SvNV(sv)) {    /* can we smush double to int */
  1360.         SvREFCNT_dec(sv);
  1361.         sv = newSViv(iv);
  1362.         }
  1363.     }
  1364.     return newSVOP(OP_CONST, 0, sv);
  1365.     }
  1366.     
  1367.   nope:
  1368.     if (!(opargs[type] & OA_OTHERINT))
  1369.     return o;
  1370.  
  1371.     if (!(hints & HINT_INTEGER)) {
  1372.     if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS))
  1373.         return o;
  1374.  
  1375.     for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
  1376.         if (curop->op_type == OP_CONST) {
  1377.         if (SvIOK(((SVOP*)curop)->op_sv))
  1378.             continue;
  1379.         return o;
  1380.         }
  1381.         if (opargs[curop->op_type] & OA_RETINTEGER)
  1382.         continue;
  1383.         return o;
  1384.     }
  1385.     o->op_ppaddr = ppaddr[++(o->op_type)];
  1386.     }
  1387.  
  1388.     return o;
  1389. }
  1390.  
  1391. OP *
  1392. gen_constant_list(o)
  1393. register OP *o;
  1394. {
  1395.     register OP *curop;
  1396.     I32 oldtmps_floor = tmps_floor;
  1397.  
  1398.     list(o);
  1399.     if (error_count)
  1400.     return o;        /* Don't attempt to run with errors */
  1401.  
  1402.     op = curop = LINKLIST(o);
  1403.     o->op_next = 0;
  1404.     pp_pushmark();
  1405.     run();
  1406.     op = curop;
  1407.     pp_anonlist();
  1408.     tmps_floor = oldtmps_floor;
  1409.  
  1410.     o->op_type = OP_RV2AV;
  1411.     o->op_ppaddr = ppaddr[OP_RV2AV];
  1412.     curop = ((UNOP*)o)->op_first;
  1413.     ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*stack_sp--));
  1414.     op_free(curop);
  1415.     linklist(o);
  1416.     return list(o);
  1417. }
  1418.  
  1419. OP *
  1420. convert(type, flags, op)
  1421. I32 type;
  1422. I32 flags;
  1423. OP* op;
  1424. {
  1425.     OP *kid;
  1426.     OP *last = 0;
  1427.  
  1428.     if (!op || op->op_type != OP_LIST)
  1429.     op = newLISTOP(OP_LIST, 0, op, Nullop);
  1430.     else
  1431.     op->op_flags &= ~(OPf_KNOW|OPf_LIST);
  1432.  
  1433.     if (!(opargs[type] & OA_MARK))
  1434.     null(cLISTOP->op_first);
  1435.  
  1436.     op->op_type = type;
  1437.     op->op_ppaddr = ppaddr[type];
  1438.     op->op_flags |= flags;
  1439.  
  1440.     op = (*check[type])(op);
  1441.     if (op->op_type != type)
  1442.     return op;
  1443.  
  1444.     if (cLISTOP->op_children < 7) {
  1445.     /* XXX do we really need to do this if we're done appending?? */
  1446.     for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
  1447.         last = kid;
  1448.     cLISTOP->op_last = last;    /* in case check substituted last arg */
  1449.     }
  1450.  
  1451.     return fold_constants(op);
  1452. }
  1453.  
  1454. /* List constructors */
  1455.  
  1456. OP *
  1457. append_elem(type, first, last)
  1458. I32 type;
  1459. OP* first;
  1460. OP* last;
  1461. {
  1462.     if (!first)
  1463.     return last;
  1464.  
  1465.     if (!last)
  1466.     return first;
  1467.  
  1468.     if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS)
  1469.         return newLISTOP(type, 0, first, last);
  1470.  
  1471.     if (first->op_flags & OPf_KIDS)
  1472.     ((LISTOP*)first)->op_last->op_sibling = last;
  1473.     else {
  1474.     first->op_flags |= OPf_KIDS;
  1475.     ((LISTOP*)first)->op_first = last;
  1476.     }
  1477.     ((LISTOP*)first)->op_last = last;
  1478.     ((LISTOP*)first)->op_children++;
  1479.     return first;
  1480. }
  1481.  
  1482. OP *
  1483. append_list(type, first, last)
  1484. I32 type;
  1485. LISTOP* first;
  1486. LISTOP* last;
  1487. {
  1488.     if (!first)
  1489.     return (OP*)last;
  1490.  
  1491.     if (!last)
  1492.     return (OP*)first;
  1493.  
  1494.     if (first->op_type != type)
  1495.     return prepend_elem(type, (OP*)first, (OP*)last);
  1496.  
  1497.     if (last->op_type != type)
  1498.     return append_elem(type, (OP*)first, (OP*)last);
  1499.  
  1500.     first->op_last->op_sibling = last->op_first;
  1501.     first->op_last = last->op_last;
  1502.     first->op_children += last->op_children;
  1503.     if (first->op_children)
  1504.     last->op_flags |= OPf_KIDS;
  1505.  
  1506.     Safefree(last);
  1507.     return (OP*)first;
  1508. }
  1509.  
  1510. OP *
  1511. prepend_elem(type, first, last)
  1512. I32 type;
  1513. OP* first;
  1514. OP* last;
  1515. {
  1516.     if (!first)
  1517.     return last;
  1518.  
  1519.     if (!last)
  1520.     return first;
  1521.  
  1522.     if (last->op_type == type) {
  1523.     if (type == OP_LIST) {    /* already a PUSHMARK there */
  1524.         first->op_sibling = ((LISTOP*)last)->op_first->op_sibling;
  1525.         ((LISTOP*)last)->op_first->op_sibling = first;
  1526.     }
  1527.     else {
  1528.         if (!(last->op_flags & OPf_KIDS)) {
  1529.         ((LISTOP*)last)->op_last = first;
  1530.         last->op_flags |= OPf_KIDS;
  1531.         }
  1532.         first->op_sibling = ((LISTOP*)last)->op_first;
  1533.         ((LISTOP*)last)->op_first = first;
  1534.     }
  1535.     ((LISTOP*)last)->op_children++;
  1536.     return last;
  1537.     }
  1538.  
  1539.     return newLISTOP(type, 0, first, last);
  1540. }
  1541.  
  1542. /* Constructors */
  1543.  
  1544. OP *
  1545. newNULLLIST()
  1546. {
  1547.     return newOP(OP_STUB, 0);
  1548. }
  1549.  
  1550. OP *
  1551. force_list(op)
  1552. OP* op;
  1553. {
  1554.     if (!op || op->op_type != OP_LIST)
  1555.     op = newLISTOP(OP_LIST, 0, op, Nullop);
  1556.     null(op);
  1557.     return op;
  1558. }
  1559.  
  1560. OP *
  1561. newLISTOP(type, flags, first, last)
  1562. I32 type;
  1563. I32 flags;
  1564. OP* first;
  1565. OP* last;
  1566. {
  1567.     LISTOP *listop;
  1568.  
  1569.     Newz(1101, listop, 1, LISTOP);
  1570.  
  1571.     listop->op_type = type;
  1572.     listop->op_ppaddr = ppaddr[type];
  1573.     listop->op_children = (first != 0) + (last != 0);
  1574.     listop->op_flags = flags;
  1575.  
  1576.     if (!last && first)
  1577.     last = first;
  1578.     else if (!first && last)
  1579.     first = last;
  1580.     else if (first)
  1581.     first->op_sibling = last;
  1582.     listop->op_first = first;
  1583.     listop->op_last = last;
  1584.     if (type == OP_LIST) {
  1585.     OP* pushop;
  1586.     pushop = newOP(OP_PUSHMARK, 0);
  1587.     pushop->op_sibling = first;
  1588.     listop->op_first = pushop;
  1589.     listop->op_flags |= OPf_KIDS;
  1590.     if (!last)
  1591.         listop->op_last = pushop;
  1592.     }
  1593.     else if (listop->op_children)
  1594.     listop->op_flags |= OPf_KIDS;
  1595.  
  1596.     return (OP*)listop;
  1597. }
  1598.  
  1599. OP *
  1600. newOP(type, flags)
  1601. I32 type;
  1602. I32 flags;
  1603. {
  1604.     OP *op;
  1605.     Newz(1101, op, 1, OP);
  1606.     op->op_type = type;
  1607.     op->op_ppaddr = ppaddr[type];
  1608.     op->op_flags = flags;
  1609.  
  1610.     op->op_next = op;
  1611.     /* op->op_private = 0; */
  1612.     if (opargs[type] & OA_RETSCALAR)
  1613.     scalar(op);
  1614.     if (opargs[type] & OA_TARGET)
  1615.     op->op_targ = pad_alloc(type, SVs_PADTMP);
  1616.     return (*check[type])(op);
  1617. }
  1618.  
  1619. OP *
  1620. newUNOP(type, flags, first)
  1621. I32 type;
  1622. I32 flags;
  1623. OP* first;
  1624. {
  1625.     UNOP *unop;
  1626.  
  1627.     if (!first)
  1628.     first = newOP(OP_STUB, 0); 
  1629.     if (opargs[type] & OA_MARK)
  1630.     first = force_list(first);
  1631.  
  1632.     Newz(1101, unop, 1, UNOP);
  1633.     unop->op_type = type;
  1634.     unop->op_ppaddr = ppaddr[type];
  1635.     unop->op_first = first;
  1636.     unop->op_flags = flags | OPf_KIDS;
  1637.     unop->op_private = 1;
  1638.  
  1639.     unop = (UNOP*)(*check[type])((OP*)unop);
  1640.     if (unop->op_next)
  1641.     return (OP*)unop;
  1642.  
  1643.     return fold_constants((OP *) unop);
  1644. }
  1645.  
  1646. OP *
  1647. newBINOP(type, flags, first, last)
  1648. I32 type;
  1649. I32 flags;
  1650. OP* first;
  1651. OP* last;
  1652. {
  1653.     BINOP *binop;
  1654.     Newz(1101, binop, 1, BINOP);
  1655.  
  1656.     if (!first)
  1657.     first = newOP(OP_NULL, 0);
  1658.  
  1659.     binop->op_type = type;
  1660.     binop->op_ppaddr = ppaddr[type];
  1661.     binop->op_first = first;
  1662.     binop->op_flags = flags | OPf_KIDS;
  1663.     if (!last) {
  1664.     last = first;
  1665.     binop->op_private = 1;
  1666.     }
  1667.     else {
  1668.     binop->op_private = 2;
  1669.     first->op_sibling = last;
  1670.     }
  1671.  
  1672.     binop = (BINOP*)(*check[type])((OP*)binop);
  1673.     if (binop->op_next)
  1674.     return (OP*)binop;
  1675.  
  1676.     binop->op_last = last = binop->op_first->op_sibling;
  1677.  
  1678.     return fold_constants((OP *)binop);
  1679. }
  1680.  
  1681. OP *
  1682. pmtrans(op, expr, repl)
  1683. OP *op;
  1684. OP *expr;
  1685. OP *repl;
  1686. {
  1687.     SV *tstr = ((SVOP*)expr)->op_sv;
  1688.     SV *rstr = ((SVOP*)repl)->op_sv;
  1689.     STRLEN tlen;
  1690.     STRLEN rlen;
  1691.     register char *t = SvPV(tstr, tlen);
  1692.     register char *r = SvPV(rstr, rlen);
  1693.     register I32 i;
  1694.     register I32 j;
  1695.     I32 delete;
  1696.     I32 complement;
  1697.     register short *tbl;
  1698.  
  1699.     tbl = (short*)cPVOP->op_pv;
  1700.     complement    = op->op_private & OPpTRANS_COMPLEMENT;
  1701.     delete    = op->op_private & OPpTRANS_DELETE;
  1702.     /* squash    = op->op_private & OPpTRANS_SQUASH; */
  1703.  
  1704.     if (complement) {
  1705.     Zero(tbl, 256, short);
  1706.     for (i = 0; i < tlen; i++)
  1707.         tbl[t[i] & 0377] = -1;
  1708.     for (i = 0, j = 0; i < 256; i++) {
  1709.         if (!tbl[i]) {
  1710.         if (j >= rlen) {
  1711.             if (delete)
  1712.             tbl[i] = -2;
  1713.             else if (rlen)
  1714.             tbl[i] = r[j-1] & 0377;
  1715.             else
  1716.             tbl[i] = i;
  1717.         }
  1718.         else
  1719.             tbl[i] = r[j++] & 0377;
  1720.         }
  1721.     }
  1722.     }
  1723.     else {
  1724.     if (!rlen && !delete) {
  1725.         r = t; rlen = tlen;
  1726.     }
  1727.     for (i = 0; i < 256; i++)
  1728.         tbl[i] = -1;
  1729.     for (i = 0, j = 0; i < tlen; i++,j++) {
  1730.         if (j >= rlen) {
  1731.         if (delete) {
  1732.             if (tbl[t[i] & 0377] == -1)
  1733.             tbl[t[i] & 0377] = -2;
  1734.             continue;
  1735.         }
  1736.         --j;
  1737.         }
  1738.         if (tbl[t[i] & 0377] == -1)
  1739.         tbl[t[i] & 0377] = r[j] & 0377;
  1740.     }
  1741.     }
  1742.     op_free(expr);
  1743.     op_free(repl);
  1744.  
  1745.     return op;
  1746. }
  1747.  
  1748. OP *
  1749. newPMOP(type, flags)
  1750. I32 type;
  1751. I32 flags;
  1752. {
  1753.     PMOP *pmop;
  1754.  
  1755.     Newz(1101, pmop, 1, PMOP);
  1756.     pmop->op_type = type;
  1757.     pmop->op_ppaddr = ppaddr[type];
  1758.     pmop->op_flags = flags;
  1759.     pmop->op_private = 0;
  1760.  
  1761.     /* link into pm list */
  1762.     if (type != OP_TRANS && curstash) {
  1763.     pmop->op_pmnext = HvPMROOT(curstash);
  1764.     HvPMROOT(curstash) = pmop;
  1765.     }
  1766.  
  1767.     return (OP*)pmop;
  1768. }
  1769.  
  1770. OP *
  1771. pmruntime(op, expr, repl)
  1772. OP *op;
  1773. OP *expr;
  1774. OP *repl;
  1775. {
  1776.     PMOP *pm;
  1777.     LOGOP *rcop;
  1778.  
  1779.     if (op->op_type == OP_TRANS)
  1780.     return pmtrans(op, expr, repl);
  1781.  
  1782.     pm = (PMOP*)op;
  1783.  
  1784.     if (expr->op_type == OP_CONST) {
  1785.     STRLEN plen;
  1786.     SV *pat = ((SVOP*)expr)->op_sv;
  1787.     char *p = SvPV(pat, plen);
  1788.     if ((op->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
  1789.         sv_setpvn(pat, "\\s+", 3);
  1790.         p = SvPV(pat, plen);
  1791.         pm->op_pmflags |= PMf_SKIPWHITE;
  1792.     }
  1793.     pm->op_pmregexp = regcomp(p, p + plen, pm);
  1794.     if (strEQ("\\s+", pm->op_pmregexp->precomp)) 
  1795.         pm->op_pmflags |= PMf_WHITE;
  1796.     hoistmust(pm);
  1797.     op_free(expr);
  1798.     }
  1799.     else {
  1800.     if (pm->op_pmflags & PMf_KEEP)
  1801.         expr = newUNOP(OP_REGCMAYBE,0,expr);
  1802.  
  1803.     Newz(1101, rcop, 1, LOGOP);
  1804.     rcop->op_type = OP_REGCOMP;
  1805.     rcop->op_ppaddr = ppaddr[OP_REGCOMP];
  1806.     rcop->op_first = scalar(expr);
  1807.     rcop->op_flags |= OPf_KIDS;
  1808.     rcop->op_private = 1;
  1809.     rcop->op_other = op;
  1810.  
  1811.     /* establish postfix order */
  1812.     if (pm->op_pmflags & PMf_KEEP) {
  1813.         LINKLIST(expr);
  1814.         rcop->op_next = expr;
  1815.         ((UNOP*)expr)->op_first->op_next = (OP*)rcop;
  1816.     }
  1817.     else {
  1818.         rcop->op_next = LINKLIST(expr);
  1819.         expr->op_next = (OP*)rcop;
  1820.     }
  1821.  
  1822.     prepend_elem(op->op_type, scalar((OP*)rcop), op);
  1823.     }
  1824.  
  1825.     if (repl) {
  1826.     OP *curop;
  1827.     if (pm->op_pmflags & PMf_EVAL)
  1828.         curop = 0;
  1829.     else if (repl->op_type == OP_CONST)
  1830.         curop = repl;
  1831.     else {
  1832.         OP *lastop = 0;
  1833.         for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
  1834.         if (opargs[curop->op_type] & OA_DANGEROUS) {
  1835.             if (curop->op_type == OP_GV) {
  1836.             GV *gv = ((GVOP*)curop)->op_gv;
  1837.             if (strchr("&`'123456789+", *GvENAME(gv)))
  1838.                 break;
  1839.             }
  1840.             else if (curop->op_type == OP_RV2CV)
  1841.             break;
  1842.             else if (curop->op_type == OP_RV2SV ||
  1843.                  curop->op_type == OP_RV2AV ||
  1844.                  curop->op_type == OP_RV2HV ||
  1845.                  curop->op_type == OP_RV2GV) {
  1846.             if (lastop && lastop->op_type != OP_GV)    /*funny deref?*/
  1847.                 break;
  1848.             }
  1849.             else if (curop->op_type == OP_PADSV ||
  1850.                  curop->op_type == OP_PADAV ||
  1851.                  curop->op_type == OP_PADHV ||
  1852.                  curop->op_type == OP_PADANY) {
  1853.                  /* is okay */
  1854.             }
  1855.             else
  1856.             break;
  1857.         }
  1858.         lastop = curop;
  1859.         }
  1860.     }
  1861.     if (curop == repl) {
  1862.         pm->op_pmflags |= PMf_CONST;    /* const for long enough */
  1863.         prepend_elem(op->op_type, scalar(repl), op);
  1864.     }
  1865.     else {
  1866.         Newz(1101, rcop, 1, LOGOP);
  1867.         rcop->op_type = OP_SUBSTCONT;
  1868.         rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
  1869.         rcop->op_first = scalar(repl);
  1870.         rcop->op_flags |= OPf_KIDS;
  1871.         rcop->op_private = 1;
  1872.         rcop->op_other = op;
  1873.  
  1874.         /* establish postfix order */
  1875.         rcop->op_next = LINKLIST(repl);
  1876.         repl->op_next = (OP*)rcop;
  1877.  
  1878.         pm->op_pmreplroot = scalar((OP*)rcop);
  1879.         pm->op_pmreplstart = LINKLIST(rcop);
  1880.         rcop->op_next = 0;
  1881.     }
  1882.     }
  1883.  
  1884.     return (OP*)pm;
  1885. }
  1886.  
  1887. OP *
  1888. newSVOP(type, flags, sv)
  1889. I32 type;
  1890. I32 flags;
  1891. SV *sv;
  1892. {
  1893.     SVOP *svop;
  1894.     Newz(1101, svop, 1, SVOP);
  1895.     svop->op_type = type;
  1896.     svop->op_ppaddr = ppaddr[type];
  1897.     svop->op_sv = sv;
  1898.     svop->op_next = (OP*)svop;
  1899.     svop->op_flags = flags;
  1900.     if (opargs[type] & OA_RETSCALAR)
  1901.     scalar((OP*)svop);
  1902.     if (opargs[type] & OA_TARGET)
  1903.     svop->op_targ = pad_alloc(type, SVs_PADTMP);
  1904.     return (*check[type])((OP*)svop);
  1905. }
  1906.  
  1907. OP *
  1908. newGVOP(type, flags, gv)
  1909. I32 type;
  1910. I32 flags;
  1911. GV *gv;
  1912. {
  1913.     GVOP *gvop;
  1914.     Newz(1101, gvop, 1, GVOP);
  1915.     gvop->op_type = type;
  1916.     gvop->op_ppaddr = ppaddr[type];
  1917.     gvop->op_gv = (GV*)SvREFCNT_inc(gv);
  1918.     gvop->op_next = (OP*)gvop;
  1919.     gvop->op_flags = flags;
  1920.     if (opargs[type] & OA_RETSCALAR)
  1921.     scalar((OP*)gvop);
  1922.     if (opargs[type] & OA_TARGET)
  1923.     gvop->op_targ = pad_alloc(type, SVs_PADTMP);
  1924.     return (*check[type])((OP*)gvop);
  1925. }
  1926.  
  1927. OP *
  1928. newPVOP(type, flags, pv)
  1929. I32 type;
  1930. I32 flags;
  1931. char *pv;
  1932. {
  1933.     PVOP *pvop;
  1934.     Newz(1101, pvop, 1, PVOP);
  1935.     pvop->op_type = type;
  1936.     pvop->op_ppaddr = ppaddr[type];
  1937.     pvop->op_pv = pv;
  1938.     pvop->op_next = (OP*)pvop;
  1939.     pvop->op_flags = flags;
  1940.     if (opargs[type] & OA_RETSCALAR)
  1941.     scalar((OP*)pvop);
  1942.     if (opargs[type] & OA_TARGET)
  1943.     pvop->op_targ = pad_alloc(type, SVs_PADTMP);
  1944.     return (*check[type])((OP*)pvop);
  1945. }
  1946.  
  1947. OP *
  1948. newCVOP(type, flags, cv, cont)
  1949. I32 type;
  1950. I32 flags;
  1951. CV *cv;
  1952. OP *cont;
  1953. {
  1954.     CVOP *cvop;
  1955.     Newz(1101, cvop, 1, CVOP);
  1956.     cvop->op_type = type;
  1957.     cvop->op_ppaddr = ppaddr[type];
  1958.     cvop->op_cv = cv;
  1959.     cvop->op_cont = cont;
  1960.     cvop->op_next = (OP*)cvop;
  1961.     cvop->op_flags = flags;
  1962.     if (opargs[type] & OA_RETSCALAR)
  1963.     scalar((OP*)cvop);
  1964.     if (opargs[type] & OA_TARGET)
  1965.     cvop->op_targ = pad_alloc(type, SVs_PADTMP);
  1966.     return (*check[type])((OP*)cvop);
  1967. }
  1968.  
  1969. void
  1970. package(op)
  1971. OP *op;
  1972. {
  1973.     SV *sv;
  1974.  
  1975.     save_hptr(&curstash);
  1976.     save_item(curstname);
  1977.     if (op) {
  1978.     STRLEN len;
  1979.     char *name;
  1980.     sv = cSVOP->op_sv;
  1981.     name = SvPV(sv, len);
  1982.     curstash = gv_stashpv(name,TRUE);
  1983.     sv_setpvn(curstname, name, len);
  1984.     op_free(op);
  1985.     }
  1986.     else {
  1987.     sv_setpv(curstname,"<none>");
  1988.     curstash = Nullhv;
  1989.     }
  1990.     copline = NOLINE;
  1991.     expect = XSTATE;
  1992. }
  1993.  
  1994. void
  1995. utilize(aver, id, arg)
  1996. int aver;
  1997. OP *id;
  1998. OP *arg;
  1999. {
  2000.     OP *pack;
  2001.     OP *meth;
  2002.     OP *rqop;
  2003.     OP *imop;
  2004.  
  2005.     if (id->op_type != OP_CONST)
  2006.     croak("Module name must be constant");
  2007.  
  2008.     meth = newSVOP(OP_CONST, 0,
  2009.     aver
  2010.         ? newSVpv("import", 6)
  2011.         : newSVpv("unimport", 8)
  2012.     );
  2013.  
  2014.     /* Make copy of id so we don't free it twice */
  2015.     pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
  2016.  
  2017.     /* Fake up a require */
  2018.     rqop = newUNOP(OP_REQUIRE, 0, id);
  2019.  
  2020.     /* Fake up an import/unimport */
  2021.     imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
  2022.             append_elem(OP_LIST,
  2023.             prepend_elem(OP_LIST, pack, list(arg)),
  2024.             newUNOP(OP_METHOD, 0, meth)));
  2025.  
  2026.     /* Fake up the BEGIN {}, which does its thing immediately. */
  2027.     newSUB(start_subparse(),
  2028.     newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)),
  2029.     append_elem(OP_LINESEQ,
  2030.         newSTATEOP(0, Nullch, rqop),
  2031.         newSTATEOP(0, Nullch, imop) ));
  2032.  
  2033.     copline = NOLINE;
  2034.     expect = XSTATE;
  2035. }
  2036.  
  2037. OP *
  2038. newSLICEOP(flags, subscript, listval)
  2039. I32 flags;
  2040. OP *subscript;
  2041. OP *listval;
  2042. {
  2043.     return newBINOP(OP_LSLICE, flags,
  2044.         list(force_list(subscript)),
  2045.         list(force_list(listval)) );
  2046. }
  2047.  
  2048. static I32
  2049. list_assignment(op)
  2050. register OP *op;
  2051. {
  2052.     if (!op)
  2053.     return TRUE;
  2054.  
  2055.     if (op->op_type == OP_NULL && op->op_flags & OPf_KIDS)
  2056.     op = cUNOP->op_first;
  2057.  
  2058.     if (op->op_type == OP_COND_EXPR) {
  2059.     I32 t = list_assignment(cCONDOP->op_first->op_sibling);
  2060.     I32 f = list_assignment(cCONDOP->op_first->op_sibling->op_sibling);
  2061.  
  2062.     if (t && f)
  2063.         return TRUE;
  2064.     if (t || f)
  2065.         yyerror("Assignment to both a list and a scalar");
  2066.     return FALSE;
  2067.     }
  2068.  
  2069.     if (op->op_type == OP_LIST || op->op_flags & OPf_PARENS ||
  2070.     op->op_type == OP_RV2AV || op->op_type == OP_RV2HV ||
  2071.     op->op_type == OP_ASLICE || op->op_type == OP_HSLICE)
  2072.     return TRUE;
  2073.  
  2074.     if (op->op_type == OP_PADAV || op->op_type == OP_PADHV)
  2075.     return TRUE;
  2076.  
  2077.     if (op->op_type == OP_RV2SV)
  2078.     return FALSE;
  2079.  
  2080.     return FALSE;
  2081. }
  2082.  
  2083. OP *
  2084. newASSIGNOP(flags, left, optype, right)
  2085. I32 flags;
  2086. OP *left;
  2087. I32 optype;
  2088. OP *right;
  2089. {
  2090.     OP *op;
  2091.  
  2092.     if (optype) {
  2093.     if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
  2094.         return newLOGOP(optype, 0,
  2095.         mod(scalar(left), optype),
  2096.         newUNOP(OP_SASSIGN, 0, scalar(right)));
  2097.     }
  2098.     else {
  2099.         return newBINOP(optype, OPf_STACKED,
  2100.         mod(scalar(left), optype), scalar(right));
  2101.     }
  2102.     }
  2103.  
  2104.     if (list_assignment(left)) {
  2105.     modcount = 0;
  2106.     eval_start = right;    /* Grandfathering $[ assignment here.  Bletch.*/
  2107.     left = mod(left, OP_AASSIGN);
  2108.     if (eval_start)
  2109.         eval_start = 0;
  2110.     else {
  2111.         op_free(left);
  2112.         op_free(right);
  2113.         return Nullop;
  2114.     }
  2115.     if (right && right->op_type == OP_SPLIT) {
  2116.         if ((op = ((LISTOP*)right)->op_first) && op->op_type == OP_PUSHRE) {
  2117.         PMOP *pm = (PMOP*)op;
  2118.         if (left->op_type == OP_RV2AV &&
  2119.             !(left->op_private & OPpLVAL_INTRO) )
  2120.         {
  2121.             op = ((UNOP*)left)->op_first;
  2122.             if (op->op_type == OP_GV && !pm->op_pmreplroot) {
  2123.             pm->op_pmreplroot = (OP*)((GVOP*)op)->op_gv;
  2124.             pm->op_pmflags |= PMf_ONCE;
  2125.             op_free(left);
  2126.             return right;
  2127.             }
  2128.         }
  2129.         else {
  2130.             if (modcount < 10000) {
  2131.             SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
  2132.             if (SvIVX(sv) == 0)
  2133.                 sv_setiv(sv, modcount+1);
  2134.             }
  2135.         }
  2136.         }
  2137.     }
  2138.     op = newBINOP(OP_AASSIGN, flags,
  2139.         list(force_list(right)),
  2140.         list(force_list(left)) );
  2141.     op->op_private = 0;
  2142.     if (!(left->op_private & OPpLVAL_INTRO)) {
  2143.         static int generation = 100;
  2144.         OP *curop;
  2145.         OP *lastop = op;
  2146.         generation++;
  2147.         for (curop = LINKLIST(op); curop != op; curop = LINKLIST(curop)) {
  2148.         if (opargs[curop->op_type] & OA_DANGEROUS) {
  2149.             if (curop->op_type == OP_GV) {
  2150.             GV *gv = ((GVOP*)curop)->op_gv;
  2151.             if (gv == defgv || SvCUR(gv) == generation)
  2152.                 break;
  2153.             SvCUR(gv) = generation;
  2154.             }
  2155.             else if (curop->op_type == OP_PADSV ||
  2156.                  curop->op_type == OP_PADAV ||
  2157.                  curop->op_type == OP_PADHV ||
  2158.                  curop->op_type == OP_PADANY) {
  2159.             SV **svp = AvARRAY(comppad_name);
  2160.             SV *sv = svp[curop->op_targ];;
  2161.             if (SvCUR(sv) == generation)
  2162.                 break;
  2163.             SvCUR(sv) = generation;    /* (SvCUR not used any more) */
  2164.             }
  2165.             else if (curop->op_type == OP_RV2CV)
  2166.             break;
  2167.             else if (curop->op_type == OP_RV2SV ||
  2168.                  curop->op_type == OP_RV2AV ||
  2169.                  curop->op_type == OP_RV2HV ||
  2170.                  curop->op_type == OP_RV2GV) {
  2171.             if (lastop->op_type != OP_GV)    /* funny deref? */
  2172.                 break;
  2173.             }
  2174.             else
  2175.             break;
  2176.         }
  2177.         lastop = curop;
  2178.         }
  2179.         if (curop != op)
  2180.         op->op_private = OPpASSIGN_COMMON;
  2181.     }
  2182.     return op;
  2183.     }
  2184.     if (!right)
  2185.     right = newOP(OP_UNDEF, 0);
  2186.     if (right->op_type == OP_READLINE) {
  2187.     right->op_flags |= OPf_STACKED;
  2188.     return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right));
  2189.     }
  2190.     else {
  2191.     eval_start = right;    /* Grandfathering $[ assignment here.  Bletch.*/
  2192.     op = newBINOP(OP_SASSIGN, flags,
  2193.         scalar(right), mod(scalar(left), OP_SASSIGN) );
  2194.     if (eval_start)
  2195.         eval_start = 0;
  2196.     else {
  2197.         op_free(op);
  2198.         return Nullop;
  2199.     }
  2200.     }
  2201.     return op;
  2202. }
  2203.  
  2204. OP *
  2205. newSTATEOP(flags, label, op)
  2206. I32 flags;
  2207. char *label;
  2208. OP *op;
  2209. {
  2210.     register COP *cop;
  2211.  
  2212.     /* Introduce my variables. */
  2213.     if (min_intro_pending) {
  2214.     SV **svp = AvARRAY(comppad_name);
  2215.     I32 i;
  2216.     SV *sv;
  2217.     for (i = min_intro_pending; i <= max_intro_pending; i++) {
  2218.         if ((sv = svp[i]) && sv != &sv_undef)
  2219.         SvIVX(sv) = 999999999;    /* Don't know scope end yet. */
  2220.         SvNVX(sv) = (double)cop_seqmax;
  2221.     }
  2222.     min_intro_pending = 0;
  2223.     comppad_name_fill = max_intro_pending;    /* Needn't search higher */
  2224.     }
  2225.  
  2226.     Newz(1101, cop, 1, COP);
  2227.     if (perldb && curcop->cop_line && curstash != debstash) {
  2228.     cop->op_type = OP_DBSTATE;
  2229.     cop->op_ppaddr = ppaddr[ OP_DBSTATE ];
  2230.     }
  2231.     else {
  2232.     cop->op_type = OP_NEXTSTATE;
  2233.     cop->op_ppaddr = ppaddr[ OP_NEXTSTATE ];
  2234.     }
  2235.     cop->op_flags = flags;
  2236.     cop->op_private = 0;
  2237.     cop->op_next = (OP*)cop;
  2238.  
  2239.     if (label) {
  2240.     cop->cop_label = label;
  2241.     hints |= HINT_BLOCK_SCOPE;
  2242.     }
  2243.     cop->cop_seq = cop_seqmax++;
  2244.     cop->cop_arybase = curcop->cop_arybase;
  2245.  
  2246.     if (copline == NOLINE)
  2247.         cop->cop_line = curcop->cop_line;
  2248.     else {
  2249.         cop->cop_line = copline;
  2250.         copline = NOLINE;
  2251.     }
  2252.     cop->cop_filegv = SvREFCNT_inc(curcop->cop_filegv);
  2253.     cop->cop_stash = curstash;
  2254.  
  2255.     if (perldb && curstash != debstash) {
  2256.     SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE);
  2257.     if (svp && *svp != &sv_undef && !SvIOK(*svp)) {
  2258.         SvIVX(*svp) = 1;
  2259.         (void)SvIOK_on(*svp);
  2260.         SvSTASH(*svp) = (HV*)cop;
  2261.     }
  2262.     }
  2263.  
  2264.     return prepend_elem(OP_LINESEQ, (OP*)cop, op);
  2265. }
  2266.  
  2267. OP *
  2268. newLOGOP(type, flags, first, other)
  2269. I32 type;
  2270. I32 flags;
  2271. OP* first;
  2272. OP* other;
  2273. {
  2274.     LOGOP *logop;
  2275.     OP *op;
  2276.  
  2277.     if (type == OP_XOR)        /* Not short circuit, but here by precedence. */
  2278.     return newBINOP(type, flags, scalar(first), scalar(other));
  2279.  
  2280.     scalarboolean(first);
  2281.     /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
  2282.     if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
  2283.     if (type == OP_AND || type == OP_OR) {
  2284.         if (type == OP_AND)
  2285.         type = OP_OR;
  2286.         else
  2287.         type = OP_AND;
  2288.         op = first;
  2289.         first = cUNOP->op_first;
  2290.         if (op->op_next)
  2291.         first->op_next = op->op_next;
  2292.         cUNOP->op_first = Nullop;
  2293.         op_free(op);
  2294.     }
  2295.     }
  2296.     if (first->op_type == OP_CONST) {
  2297.     if (dowarn && (first->op_private & OPpCONST_BARE))
  2298.         warn("Probable precedence problem on %s", op_name[type]);
  2299.     if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
  2300.         op_free(first);
  2301.         return other;
  2302.     }
  2303.     else {
  2304.         op_free(other);
  2305.         return first;
  2306.     }
  2307.     }
  2308.     else if (first->op_type == OP_WANTARRAY) {
  2309.     if (type == OP_AND)
  2310.         list(other);
  2311.     else
  2312.         scalar(other);
  2313.     }
  2314.  
  2315.     if (!other)
  2316.     return first;
  2317.  
  2318.     if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
  2319.     other->op_private |= OPpASSIGN_BACKWARDS;  /* other is an OP_SASSIGN */
  2320.  
  2321.     Newz(1101, logop, 1, LOGOP);
  2322.  
  2323.     logop->op_type = type;
  2324.     logop->op_ppaddr = ppaddr[type];
  2325.     logop->op_first = first;
  2326.     logop->op_flags = flags | OPf_KIDS;
  2327.     logop->op_other = LINKLIST(other);
  2328.     logop->op_private = 1;
  2329.  
  2330.     /* establish postfix order */
  2331.     logop->op_next = LINKLIST(first);
  2332.     first->op_next = (OP*)logop;
  2333.     first->op_sibling = other;
  2334.  
  2335.     op = newUNOP(OP_NULL, 0, (OP*)logop);
  2336.     other->op_next = op;
  2337.  
  2338.     return op;
  2339. }
  2340.  
  2341. OP *
  2342. newCONDOP(flags, first, true, false)
  2343. I32 flags;
  2344. OP* first;
  2345. OP* true;
  2346. OP* false;
  2347. {
  2348.     CONDOP *condop;
  2349.     OP *op;
  2350.  
  2351.     if (!false)
  2352.     return newLOGOP(OP_AND, 0, first, true);
  2353.     if (!true)
  2354.     return newLOGOP(OP_OR, 0, first, false);
  2355.  
  2356.     scalarboolean(first);
  2357.     if (first->op_type == OP_CONST) {
  2358.     if (SvTRUE(((SVOP*)first)->op_sv)) {
  2359.         op_free(first);
  2360.         op_free(false);
  2361.         return true;
  2362.     }
  2363.     else {
  2364.         op_free(first);
  2365.         op_free(true);
  2366.         return false;
  2367.     }
  2368.     }
  2369.     else if (first->op_type == OP_WANTARRAY) {
  2370.     list(true);
  2371.     scalar(false);
  2372.     }
  2373.     Newz(1101, condop, 1, CONDOP);
  2374.  
  2375.     condop->op_type = OP_COND_EXPR;
  2376.     condop->op_ppaddr = ppaddr[OP_COND_EXPR];
  2377.     condop->op_first = first;
  2378.     condop->op_flags = flags | OPf_KIDS;
  2379.     condop->op_true = LINKLIST(true);
  2380.     condop->op_false = LINKLIST(false);
  2381.     condop->op_private = 1;
  2382.  
  2383.     /* establish postfix order */
  2384.     condop->op_next = LINKLIST(first);
  2385.     first->op_next = (OP*)condop;
  2386.  
  2387.     first->op_sibling = true;
  2388.     true->op_sibling = false;
  2389.     op = newUNOP(OP_NULL, 0, (OP*)condop);
  2390.  
  2391.     true->op_next = op;
  2392.     false->op_next = op;
  2393.  
  2394.     return op;
  2395. }
  2396.  
  2397. OP *
  2398. newRANGE(flags, left, right)
  2399. I32 flags;
  2400. OP *left;
  2401. OP *right;
  2402. {
  2403.     CONDOP *condop;
  2404.     OP *flip;
  2405.     OP *flop;
  2406.     OP *op;
  2407.  
  2408.     Newz(1101, condop, 1, CONDOP);
  2409.  
  2410.     condop->op_type = OP_RANGE;
  2411.     condop->op_ppaddr = ppaddr[OP_RANGE];
  2412.     condop->op_first = left;
  2413.     condop->op_flags = OPf_KIDS;
  2414.     condop->op_true = LINKLIST(left);
  2415.     condop->op_false = LINKLIST(right);
  2416.     condop->op_private = 1;
  2417.  
  2418.     left->op_sibling = right;
  2419.  
  2420.     condop->op_next = (OP*)condop;
  2421.     flip = newUNOP(OP_FLIP, flags, (OP*)condop);
  2422.     flop = newUNOP(OP_FLOP, 0, flip);
  2423.     op = newUNOP(OP_NULL, 0, flop);
  2424.     linklist(flop);
  2425.  
  2426.     left->op_next = flip;
  2427.     right->op_next = flop;
  2428.  
  2429.     condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
  2430.     sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
  2431.     flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
  2432.     sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
  2433.  
  2434.     flip->op_private =  left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
  2435.     flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
  2436.  
  2437.     flip->op_next = op;
  2438.     if (!flip->op_private || !flop->op_private)
  2439.     linklist(op);        /* blow off optimizer unless constant */
  2440.  
  2441.     return op;
  2442. }
  2443.  
  2444. OP *
  2445. newLOOPOP(flags, debuggable, expr, block)
  2446. I32 flags;
  2447. I32 debuggable;
  2448. OP *expr;
  2449. OP *block;
  2450. {
  2451.     OP* listop;
  2452.     OP* op;
  2453.     int once = block && block->op_flags & OPf_SPECIAL &&
  2454.       (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
  2455.  
  2456.     if (expr) {
  2457.     if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
  2458.         return block;    /* do {} while 0 does once */
  2459.     else if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)
  2460.         expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr);
  2461.     }
  2462.  
  2463.     listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
  2464.     op = newLOGOP(OP_AND, 0, expr, listop);
  2465.  
  2466.     ((LISTOP*)listop)->op_last->op_next = LINKLIST(op);
  2467.  
  2468.     if (once && op != listop)
  2469.     op->op_next = ((LOGOP*)cUNOP->op_first)->op_other;
  2470.  
  2471.     if (op == listop)
  2472.     op = newUNOP(OP_NULL, 0, op);    /* or do {} while 1 loses outer block */
  2473.  
  2474.     op->op_flags |= flags;
  2475.     op = scope(op);
  2476.     op->op_flags |= OPf_SPECIAL;    /* suppress POPBLOCK curpm restoration*/
  2477.     return op;
  2478. }
  2479.  
  2480. OP *
  2481. newWHILEOP(flags, debuggable, loop, expr, block, cont)
  2482. I32 flags;
  2483. I32 debuggable;
  2484. LOOP *loop;
  2485. OP *expr;
  2486. OP *block;
  2487. OP *cont;
  2488. {
  2489.     OP *redo;
  2490.     OP *next = 0;
  2491.     OP *listop;
  2492.     OP *op;
  2493.     OP *condop;
  2494.  
  2495.     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) {
  2496.     expr = newUNOP(OP_DEFINED, 0,
  2497.         newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
  2498.     }
  2499.  
  2500.     if (!block)
  2501.     block = newOP(OP_NULL, 0);
  2502.  
  2503.     if (cont)
  2504.     next = LINKLIST(cont);
  2505.     if (expr)
  2506.     cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
  2507.  
  2508.     listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
  2509.     redo = LINKLIST(listop);
  2510.  
  2511.     if (expr) {
  2512.     op = newLOGOP(OP_AND, 0, expr, scalar(listop));
  2513.     if (op == expr && op->op_type == OP_CONST && !SvTRUE(cSVOP->op_sv)) {
  2514.         op_free(expr);        /* oops, it's a while (0) */
  2515.         op_free((OP*)loop);
  2516.         return Nullop;        /* (listop already freed by newLOGOP) */
  2517.     }
  2518.     ((LISTOP*)listop)->op_last->op_next = condop = 
  2519.         (op == listop ? redo : LINKLIST(op));
  2520.     if (!next)
  2521.         next = condop;
  2522.     }
  2523.     else
  2524.     op = listop;
  2525.  
  2526.     if (!loop) {
  2527.     Newz(1101,loop,1,LOOP);
  2528.     loop->op_type = OP_ENTERLOOP;
  2529.     loop->op_ppaddr = ppaddr[OP_ENTERLOOP];
  2530.     loop->op_private = 0;
  2531.     loop->op_next = (OP*)loop;
  2532.     }
  2533.  
  2534.     op = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, op);
  2535.  
  2536.     loop->op_redoop = redo;
  2537.     loop->op_lastop = op;
  2538.  
  2539.     if (next)
  2540.     loop->op_nextop = next;
  2541.     else
  2542.     loop->op_nextop = op;
  2543.  
  2544.     op->op_flags |= flags;
  2545.     return op;
  2546. }
  2547.  
  2548. OP *
  2549. #ifndef CAN_PROTOTYPE
  2550. newFOROP(flags,label,forline,sv,expr,block,cont)
  2551. I32 flags;
  2552. char *label;
  2553. line_t forline;
  2554. OP* sv;
  2555. OP* expr;
  2556. OP*block;
  2557. OP*cont;
  2558. #else
  2559. newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
  2560. #endif /* CAN_PROTOTYPE */
  2561. {
  2562.     LOOP *loop;
  2563.     int padoff = 0;
  2564.  
  2565.     copline = forline;
  2566.     if (sv) {
  2567.     if (sv->op_type == OP_RV2SV) {    /* symbol table variable */
  2568.         sv->op_type = OP_RV2GV;
  2569.         sv->op_ppaddr = ppaddr[OP_RV2GV];
  2570.     }
  2571.     else if (sv->op_type == OP_PADSV) { /* private variable */
  2572.         padoff = sv->op_targ;
  2573.         op_free(sv);
  2574.         sv = Nullop;
  2575.     }
  2576.     else
  2577.         croak("Can't use %s for loop variable", op_name[sv->op_type]);
  2578.     }
  2579.     else {
  2580.     sv = newGVOP(OP_GV, 0, defgv);
  2581.     }
  2582.     loop = (LOOP*)list(convert(OP_ENTERITER, 0,
  2583.     append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
  2584.             scalar(sv))));
  2585.     assert(!loop->op_next);
  2586.     Renew(loop, 1, LOOP);
  2587.     loop->op_targ = padoff;
  2588.     return newSTATEOP(0, label, newWHILEOP(flags, 1, loop,
  2589.     newOP(OP_ITER, 0), block, cont));
  2590. }
  2591.  
  2592. OP*
  2593. newLOOPEX(type, label)
  2594. I32 type;
  2595. OP* label;
  2596. {
  2597.     OP *op;
  2598.     if (type != OP_GOTO || label->op_type == OP_CONST) {
  2599.     op = newPVOP(type, 0, savepv(
  2600.         label->op_type == OP_CONST
  2601.             ? SvPVx(((SVOP*)label)->op_sv, na)
  2602.             : "" ));
  2603.     op_free(label);
  2604.     }
  2605.     else {
  2606.     if (label->op_type == OP_ENTERSUB)
  2607.         label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
  2608.     op = newUNOP(type, OPf_STACKED, label);
  2609.     }
  2610.     hints |= HINT_BLOCK_SCOPE;
  2611.     return op;
  2612. }
  2613.  
  2614. void
  2615. cv_undef(cv)
  2616. CV *cv;
  2617. {
  2618.     if (!CvXSUB(cv) && CvROOT(cv)) {
  2619.     if (CvDEPTH(cv))
  2620.         croak("Can't undef active subroutine");
  2621.     ENTER;
  2622.  
  2623.     SAVESPTR(curpad);
  2624.     curpad = 0;
  2625.  
  2626.     if (!SvFLAGS(cv) & SVpcv_CLONED)
  2627.         op_free(CvROOT(cv));
  2628.     CvROOT(cv) = Nullop;
  2629.     if (CvPADLIST(cv)) {
  2630.         I32 i = AvFILL(CvPADLIST(cv));
  2631.         while (i >= 0) {
  2632.         SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
  2633.         if (svp)
  2634.             SvREFCNT_dec(*svp);
  2635.         }
  2636.         SvREFCNT_dec((SV*)CvPADLIST(cv));
  2637.         CvPADLIST(cv) = Nullav;
  2638.     }
  2639.     SvREFCNT_dec(CvGV(cv));
  2640.     CvGV(cv) = Nullgv;
  2641.     LEAVE;
  2642.     }
  2643. }
  2644.  
  2645. CV *
  2646. cv_clone(proto)
  2647. CV* proto;
  2648. {
  2649.     AV* av;
  2650.     I32 ix;
  2651.     AV* protopadlist = CvPADLIST(proto);
  2652.     AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
  2653.     AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
  2654.     SV** svp = AvARRAY(protopad);
  2655.     AV* comppadlist;
  2656.     CV* cv;
  2657.  
  2658.     ENTER;
  2659.     SAVESPTR(curpad);
  2660.     SAVESPTR(comppad);
  2661.     SAVESPTR(compcv);
  2662.  
  2663.     cv = compcv = (CV*)NEWSV(1104,0);
  2664.     sv_upgrade((SV *)cv, SVt_PVCV);
  2665.     SvFLAGS(cv) |= SVpcv_CLONED;
  2666.  
  2667.     CvFILEGV(cv)    = CvFILEGV(proto);
  2668.     CvGV(cv)        = SvREFCNT_inc(CvGV(proto));
  2669.     CvSTASH(cv)        = CvSTASH(proto);
  2670.     CvROOT(cv)        = CvROOT(proto);
  2671.     CvSTART(cv)        = CvSTART(proto);
  2672.     CvOUTSIDE(cv)    = CvOUTSIDE(proto);
  2673.  
  2674.     comppad = newAV();
  2675.  
  2676.     comppadlist = newAV();
  2677.     AvREAL_off(comppadlist);
  2678.     av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name));
  2679.     av_store(comppadlist, 1, SvREFCNT_inc((SV*)comppad));
  2680.     CvPADLIST(cv) = comppadlist;
  2681.     av_extend(comppad, AvFILL(protopad));
  2682.     curpad = AvARRAY(comppad);
  2683.  
  2684.     av = newAV();           /* will be @_ */
  2685.     av_extend(av, 0);
  2686.     av_store(comppad, 0, (SV*)av);
  2687.     AvFLAGS(av) = AVf_REIFY;
  2688.  
  2689.     svp = AvARRAY(protopad_name);
  2690.     for ( ix = AvFILL(protopad); ix > 0; ix--) {
  2691.     SV *sv;
  2692.     if (svp[ix] != &sv_undef) {
  2693.         char *name = SvPVX(svp[ix]);    /* XXX */
  2694.         if (SvFLAGS(svp[ix]) & SVf_FAKE) {    /* lexical from outside? */
  2695.         I32 off = pad_findlex(name,ix,curcop->cop_seq, CvOUTSIDE(proto), cxstack_ix);
  2696.         if (off != ix)
  2697.             croak("panic: cv_clone: %s", name);
  2698.         }
  2699.         else {                /* our own lexical */
  2700.         if (*name == '@')
  2701.             av_store(comppad, ix, sv = (SV*)newAV());
  2702.         else if (*name == '%')
  2703.             av_store(comppad, ix, sv = (SV*)newHV());
  2704.         else
  2705.             av_store(comppad, ix, sv = NEWSV(0,0));
  2706.         SvPADMY_on(sv);
  2707.         }
  2708.     }
  2709.     else {
  2710.         av_store(comppad, ix, sv = NEWSV(0,0));
  2711.         SvPADTMP_on(sv);
  2712.     }
  2713.     }
  2714.  
  2715.     LEAVE;
  2716.     return cv;
  2717. }
  2718.  
  2719. CV *
  2720. newSUB(floor,op,block)
  2721. I32 floor;
  2722. OP *op;
  2723. OP *block;
  2724. {
  2725.     register CV *cv;
  2726.     char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__";
  2727.     GV *gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV);
  2728.     AV* av;
  2729.     char *s;
  2730.     I32 ix;
  2731.  
  2732.     if (op)
  2733.     sub_generation++;
  2734.     if (cv = GvCV(gv)) {
  2735.     if (GvCVGEN(gv))
  2736.         cv = 0;            /* just a cached method */
  2737.     else if (CvROOT(cv) || CvXSUB(cv) || GvFLAGS(gv) & GVf_IMPORTED) {
  2738.         if (dowarn) {        /* already defined (or promised)? */
  2739.         line_t oldline = curcop->cop_line;
  2740.  
  2741.         curcop->cop_line = copline;
  2742.         warn("Subroutine %s redefined",name);
  2743.         curcop->cop_line = oldline;
  2744.         }
  2745.         SvREFCNT_dec(cv);
  2746.         cv = 0;
  2747.     }
  2748.     }
  2749.     if (cv) {                /* must reuse cv if autoloaded */
  2750.     if (CvGV(cv)) {
  2751.         assert(SvREFCNT(CvGV(cv)) > 1);
  2752.         SvREFCNT_dec(CvGV(cv));
  2753.     }
  2754.     CvOUTSIDE(cv) = CvOUTSIDE(compcv);
  2755.     CvPADLIST(cv) = CvPADLIST(compcv);
  2756.     SvREFCNT_dec(compcv);
  2757.     }
  2758.     else {
  2759.     cv = compcv;
  2760.     }
  2761.     GvCV(gv) = cv;
  2762.     GvCVGEN(gv) = 0;
  2763.     CvFILEGV(cv) = curcop->cop_filegv;
  2764.     CvGV(cv) = SvREFCNT_inc(gv);
  2765.     CvSTASH(cv) = curstash;
  2766.  
  2767.     if (!block) {
  2768.     CvROOT(cv) = 0;
  2769.     op_free(op);
  2770.     copline = NOLINE;
  2771.     LEAVE_SCOPE(floor);
  2772.     return cv;
  2773.     }
  2774.  
  2775.     av = newAV();            /* Will be @_ */
  2776.     av_extend(av, 0);
  2777.     av_store(comppad, 0, (SV*)av);
  2778.     AvFLAGS(av) = AVf_REIFY;
  2779.  
  2780.     for (ix = AvFILL(comppad); ix > 0; ix--) {
  2781.     if (!SvPADMY(curpad[ix]))
  2782.         SvPADTMP_on(curpad[ix]);
  2783.     }
  2784.  
  2785.     if (AvFILL(comppad_name) < AvFILL(comppad))
  2786.     av_store(comppad_name, AvFILL(comppad), Nullsv);
  2787.  
  2788.     CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
  2789.     CvSTART(cv) = LINKLIST(CvROOT(cv));
  2790.     CvROOT(cv)->op_next = 0;
  2791.     peep(CvSTART(cv));
  2792.     if (s = strrchr(name,':'))
  2793.     s++;
  2794.     else
  2795.     s = name;
  2796.     if (strEQ(s, "BEGIN")) {
  2797.     line_t oldline = compiling.cop_line;
  2798.  
  2799.     ENTER;
  2800.     SAVESPTR(compiling.cop_filegv);
  2801.     SAVEI32(perldb);
  2802.     if (!beginav)
  2803.         beginav = newAV();
  2804.     av_push(beginav, (SV *)cv);
  2805.     DEBUG_x( dump_sub(gv) );
  2806.     rs = nrs;
  2807.     rslen = nrslen;
  2808.     rschar = nrschar;
  2809.     rspara = (nrslen == 2);
  2810.     GvCV(gv) = 0;
  2811.     calllist(beginav);
  2812.     rs = "\n";
  2813.     rslen = 1;
  2814.     rschar = '\n';
  2815.     rspara = 0;
  2816.     curcop = &compiling;
  2817.     curcop->cop_line = oldline;    /* might have recursed to yylex */
  2818.     LEAVE;
  2819.     }
  2820.     else if (strEQ(s, "END")) {
  2821.     if (!endav)
  2822.         endav = newAV();
  2823.     av_unshift(endav, 1);
  2824.     av_store(endav, 0, SvREFCNT_inc(cv));
  2825.     }
  2826.     if (perldb && curstash != debstash) {
  2827.     SV *sv;
  2828.     SV *tmpstr = sv_newmortal();
  2829.  
  2830.     sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
  2831.     sv = newSVpv(buf,0);
  2832.     sv_catpv(sv,"-");
  2833.     sprintf(buf,"%ld",(long)curcop->cop_line);
  2834.     sv_catpv(sv,buf);
  2835.     gv_efullname(tmpstr,gv);
  2836.     hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
  2837.     }
  2838.     op_free(op);
  2839.     copline = NOLINE;
  2840.     LEAVE_SCOPE(floor);
  2841.     if (!op) {
  2842.     GvCV(gv) = 0;    /* Will remember in SVOP instead. */
  2843.     SvFLAGS(cv) |= SVpcv_ANON;
  2844.     }
  2845.     return cv;
  2846. }
  2847.  
  2848. #ifdef DEPRECATED
  2849. CV *
  2850. newXSUB(name, ix, subaddr, filename)
  2851. char *name;
  2852. I32 ix;
  2853. I32 (*subaddr)();
  2854. char *filename;
  2855. {
  2856.     CV* cv = newXS(name, (void(*)())subaddr, filename);
  2857.     CvOLDSTYLE(cv) = TRUE;
  2858.     CvXSUBANY(cv).any_i32 = ix;
  2859.     return cv;
  2860. }
  2861. #endif
  2862.  
  2863. CV *
  2864. newXS(name, subaddr, filename)
  2865. char *name;
  2866. void (*subaddr) _((CV*));
  2867. char *filename;
  2868. {
  2869.     register CV *cv;
  2870.     GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV);
  2871.     char *s;
  2872.  
  2873.     if (name)
  2874.     sub_generation++;
  2875.     if (cv = GvCV(gv)) {
  2876.     if (GvCVGEN(gv))
  2877.         cv = 0;            /* just a cached method */
  2878.     else if (CvROOT(cv) || CvXSUB(cv)) {    /* already defined? */
  2879.         if (dowarn) {
  2880.         line_t oldline = curcop->cop_line;
  2881.  
  2882.         curcop->cop_line = copline;
  2883.         warn("Subroutine %s redefined",name);
  2884.         curcop->cop_line = oldline;
  2885.         }
  2886.         SvREFCNT_dec(cv);
  2887.         cv = 0;
  2888.     }
  2889.     }
  2890.     if (cv) {                /* must reuse cv if autoloaded */
  2891.     assert(SvREFCNT(CvGV(cv)) > 1);
  2892.     SvREFCNT_dec(CvGV(cv));
  2893.     }
  2894.     else {
  2895.     cv = (CV*)NEWSV(1105,0);
  2896.     sv_upgrade((SV *)cv, SVt_PVCV);
  2897.     }
  2898.     GvCV(gv) = cv;
  2899.     CvGV(cv) = SvREFCNT_inc(gv);
  2900.     GvCVGEN(gv) = 0;
  2901.     CvFILEGV(cv) = gv_fetchfile(filename);
  2902.     CvXSUB(cv) = subaddr;
  2903.     if (!name)
  2904.     s = "__ANON__";
  2905.     else if (s = strrchr(name,':'))
  2906.     s++;
  2907.     else
  2908.     s = name;
  2909.     if (strEQ(s, "BEGIN")) {
  2910.     if (!beginav)
  2911.         beginav = newAV();
  2912.     av_push(beginav, SvREFCNT_inc(gv));
  2913.     }
  2914.     else if (strEQ(s, "END")) {
  2915.     if (!endav)
  2916.         endav = newAV();
  2917.     av_unshift(endav, 1);
  2918.     av_store(endav, 0, SvREFCNT_inc(gv));
  2919.     }
  2920.     if (!name) {
  2921.     GvCV(gv) = 0;    /* Will remember elsewhere instead. */
  2922.     SvFLAGS(cv) |= SVpcv_ANON;
  2923.     }
  2924.     return cv;
  2925. }
  2926.  
  2927. void
  2928. newFORM(floor,op,block)
  2929. I32 floor;
  2930. OP *op;
  2931. OP *block;
  2932. {
  2933.     register CV *cv;
  2934.     char *name;
  2935.     GV *gv;
  2936.     AV* av;
  2937.     I32 ix;
  2938.  
  2939.     if (op)
  2940.     name = SvPVx(cSVOP->op_sv, na);
  2941.     else
  2942.     name = "STDOUT";
  2943.     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
  2944.     SvMULTI_on(gv);
  2945.     if (cv = GvFORM(gv)) {
  2946.     if (dowarn) {
  2947.         line_t oldline = curcop->cop_line;
  2948.  
  2949.         curcop->cop_line = copline;
  2950.         warn("Format %s redefined",name);
  2951.         curcop->cop_line = oldline;
  2952.     }
  2953.     SvREFCNT_dec(cv);
  2954.     }
  2955.     cv = compcv;
  2956.     GvFORM(gv) = cv;
  2957.     CvGV(cv) = SvREFCNT_inc(gv);
  2958.     CvFILEGV(cv) = curcop->cop_filegv;
  2959.  
  2960.     for (ix = AvFILL(comppad); ix > 0; ix--) {
  2961.     if (!SvPADMY(curpad[ix]))
  2962.         SvPADTMP_on(curpad[ix]);
  2963.     }
  2964.  
  2965.     CvPADLIST(cv) = av = newAV();
  2966.     AvREAL_off(av);
  2967.     av_store(av, 1, SvREFCNT_inc((SV*)comppad));
  2968.     AvFILL(av) = 1;
  2969.  
  2970.     CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
  2971.     CvSTART(cv) = LINKLIST(CvROOT(cv));
  2972.     CvROOT(cv)->op_next = 0;
  2973.     peep(CvSTART(cv));
  2974.     FmLINES(cv) = 0;
  2975.     op_free(op);
  2976.     copline = NOLINE;
  2977.     LEAVE_SCOPE(floor);
  2978. }
  2979.  
  2980. OP *
  2981. newMETHOD(ref,name)
  2982. OP *ref;
  2983. OP *name;
  2984. {
  2985.     LOGOP* mop;
  2986.     Newz(1101, mop, 1, LOGOP);
  2987.     mop->op_type = OP_METHOD;
  2988.     mop->op_ppaddr = ppaddr[OP_METHOD];
  2989.     mop->op_first = scalar(ref);
  2990.     mop->op_flags |= OPf_KIDS;
  2991.     mop->op_private = 1;
  2992.     mop->op_other = LINKLIST(name);
  2993.     mop->op_targ = pad_alloc(OP_METHOD, SVs_PADTMP);
  2994.     mop->op_next = LINKLIST(ref);
  2995.     ref->op_next = (OP*)mop;
  2996.     return scalar((OP*)mop);
  2997. }
  2998.  
  2999. OP *
  3000. newANONLIST(op)
  3001. OP* op;
  3002. {
  3003.     return newUNOP(OP_REFGEN, 0,
  3004.     mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN));
  3005. }
  3006.  
  3007. OP *
  3008. newANONHASH(op)
  3009. OP* op;
  3010. {
  3011.     return newUNOP(OP_REFGEN, 0,
  3012.     mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN));
  3013. }
  3014.  
  3015. OP *
  3016. newANONSUB(floor, block)
  3017. I32 floor;
  3018. OP *block;
  3019. {
  3020.     return newUNOP(OP_REFGEN, 0,
  3021.     newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, block)));
  3022. }
  3023.  
  3024. OP *
  3025. oopsAV(o)
  3026. OP *o;
  3027. {
  3028.     switch (o->op_type) {
  3029.     case OP_PADSV:
  3030.     o->op_type = OP_PADAV;
  3031.     o->op_ppaddr = ppaddr[OP_PADAV];
  3032.     return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
  3033.     
  3034.     case OP_RV2SV:
  3035.     o->op_type = OP_RV2AV;
  3036.     o->op_ppaddr = ppaddr[OP_RV2AV];
  3037.     ref(o, OP_RV2AV);
  3038.     break;
  3039.  
  3040.     default:
  3041.     warn("oops: oopsAV");
  3042.     break;
  3043.     }
  3044.     return o;
  3045. }
  3046.  
  3047. OP *
  3048. oopsHV(o)
  3049. OP *o;
  3050. {
  3051.     switch (o->op_type) {
  3052.     case OP_PADSV:
  3053.     case OP_PADAV:
  3054.     o->op_type = OP_PADHV;
  3055.     o->op_ppaddr = ppaddr[OP_PADHV];
  3056.     return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
  3057.  
  3058.     case OP_RV2SV:
  3059.     case OP_RV2AV:
  3060.     o->op_type = OP_RV2HV;
  3061.     o->op_ppaddr = ppaddr[OP_RV2HV];
  3062.     ref(o, OP_RV2HV);
  3063.     break;
  3064.  
  3065.     default:
  3066.     warn("oops: oopsHV");
  3067.     break;
  3068.     }
  3069.     return o;
  3070. }
  3071.  
  3072. OP *
  3073. newAVREF(o)
  3074. OP *o;
  3075. {
  3076.     if (o->op_type == OP_PADANY) {
  3077.     o->op_type = OP_PADAV;
  3078.     o->op_ppaddr = ppaddr[OP_PADAV];
  3079.     return o;
  3080.     }
  3081.     return newUNOP(OP_RV2AV, 0, scalar(o));
  3082. }
  3083.  
  3084. OP *
  3085. newGVREF(type,o)
  3086. I32 type;
  3087. OP *o;
  3088. {
  3089.     if (type == OP_MAPSTART)
  3090.     return newUNOP(OP_NULL, 0, o);
  3091.     return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
  3092. }
  3093.  
  3094. OP *
  3095. newHVREF(o)
  3096. OP *o;
  3097. {
  3098.     if (o->op_type == OP_PADANY) {
  3099.     o->op_type = OP_PADHV;
  3100.     o->op_ppaddr = ppaddr[OP_PADHV];
  3101.     return o;
  3102.     }
  3103.     return newUNOP(OP_RV2HV, 0, scalar(o));
  3104. }
  3105.  
  3106. OP *
  3107. oopsCV(o)
  3108. OP *o;
  3109. {
  3110.     croak("NOT IMPL LINE %d",__LINE__);
  3111.     /* STUB */
  3112.     return o;
  3113. }
  3114.  
  3115. OP *
  3116. newCVREF(o)
  3117. OP *o;
  3118. {
  3119.     return newUNOP(OP_RV2CV, 0, scalar(o));
  3120. }
  3121.  
  3122. OP *
  3123. newSVREF(o)
  3124. OP *o;
  3125. {
  3126.     if (o->op_type == OP_PADANY) {
  3127.     o->op_type = OP_PADSV;
  3128.     o->op_ppaddr = ppaddr[OP_PADSV];
  3129.     return o;
  3130.     }
  3131.     return newUNOP(OP_RV2SV, 0, scalar(o));
  3132. }
  3133.  
  3134. /* Check routines. */
  3135.  
  3136. OP *
  3137. ck_concat(op)
  3138. OP *op;
  3139. {
  3140.     if (cUNOP->op_first->op_type == OP_CONCAT)
  3141.     op->op_flags |= OPf_STACKED;
  3142.     return op;
  3143. }
  3144.  
  3145. OP *
  3146. ck_spair(op)
  3147. OP *op;
  3148. {
  3149.     if (op->op_flags & OPf_KIDS) {
  3150.     OP* newop;
  3151.     OP* kid;
  3152.     op = modkids(ck_fun(op), op->op_type);
  3153.     kid = cUNOP->op_first;
  3154.     newop = kUNOP->op_first->op_sibling;
  3155.     if (newop &&
  3156.         (newop->op_sibling ||
  3157.          !(opargs[newop->op_type] & OA_RETSCALAR) ||
  3158.          newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
  3159.          newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
  3160.         
  3161.         return op;
  3162.     }
  3163.     op_free(kUNOP->op_first);
  3164.     kUNOP->op_first = newop;
  3165.     }
  3166.     op->op_ppaddr = ppaddr[++op->op_type];
  3167.     return ck_fun(op);
  3168. }
  3169.  
  3170. OP *
  3171. ck_delete(op)
  3172. OP *op;
  3173. {
  3174.     op = ck_fun(op);
  3175.     if (op->op_flags & OPf_KIDS) {
  3176.     OP *kid = cUNOP->op_first;
  3177.     if (kid->op_type != OP_HELEM)
  3178.         croak("%s argument is not a HASH element", op_name[op->op_type]);
  3179.     null(kid);
  3180.     }
  3181.     return op;
  3182. }
  3183.  
  3184. OP *
  3185. ck_eof(op)
  3186. OP *op;
  3187. {
  3188.     I32 type = op->op_type;
  3189.  
  3190.     if (op->op_flags & OPf_KIDS) {
  3191.     if (cLISTOP->op_first->op_type == OP_STUB) {
  3192.         op_free(op);
  3193.         op = newUNOP(type, OPf_SPECIAL,
  3194.         newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
  3195.     }
  3196.     return ck_fun(op);
  3197.     }
  3198.     return op;
  3199. }
  3200.  
  3201. OP *
  3202. ck_eval(op)
  3203. OP *op;
  3204. {
  3205.     hints |= HINT_BLOCK_SCOPE;
  3206.     if (op->op_flags & OPf_KIDS) {
  3207.     SVOP *kid = (SVOP*)cUNOP->op_first;
  3208.  
  3209.     if (!kid) {
  3210.         op->op_flags &= ~OPf_KIDS;
  3211.         null(op);
  3212.     }
  3213.     else if (kid->op_type == OP_LINESEQ) {
  3214.         LOGOP *enter;
  3215.  
  3216.         kid->op_next = op->op_next;
  3217.         cUNOP->op_first = 0;
  3218.         op_free(op);
  3219.  
  3220.         Newz(1101, enter, 1, LOGOP);
  3221.         enter->op_type = OP_ENTERTRY;
  3222.         enter->op_ppaddr = ppaddr[OP_ENTERTRY];
  3223.         enter->op_private = 0;
  3224.  
  3225.         /* establish postfix order */
  3226.         enter->op_next = (OP*)enter;
  3227.  
  3228.         op = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
  3229.         op->op_type = OP_LEAVETRY;
  3230.         op->op_ppaddr = ppaddr[OP_LEAVETRY];
  3231.         enter->op_other = op;
  3232.         return op;
  3233.     }
  3234.     }
  3235.     else {
  3236.     op_free(op);
  3237.     op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
  3238.     }
  3239.     op->op_targ = (PADOFFSET)hints;
  3240.     return op;
  3241. }
  3242.  
  3243. OP *
  3244. ck_exec(op)
  3245. OP *op;
  3246. {
  3247.     OP *kid;
  3248.     if (op->op_flags & OPf_STACKED) {
  3249.     op = ck_fun(op);
  3250.     kid = cUNOP->op_first->op_sibling;
  3251.     if (kid->op_type == OP_RV2GV)
  3252.         null(kid);
  3253.     }
  3254.     else
  3255.     op = listkids(op);
  3256.     return op;
  3257. }
  3258.  
  3259. OP *
  3260. ck_gvconst(o)
  3261. register OP *o;
  3262. {
  3263.     o = fold_constants(o);
  3264.     if (o->op_type == OP_CONST)
  3265.     o->op_type = OP_GV;
  3266.     return o;
  3267. }
  3268.  
  3269. OP *
  3270. ck_rvconst(op)
  3271. register OP *op;
  3272. {
  3273.     SVOP *kid = (SVOP*)cUNOP->op_first;
  3274.  
  3275.     op->op_private = (hints & HINT_STRICT_REFS);
  3276.     if (kid->op_type == OP_CONST) {
  3277.     int iscv = (op->op_type==OP_RV2CV)*2;
  3278.     GV *gv = 0;
  3279.     kid->op_type = OP_GV;
  3280.     for (gv = 0; !gv; iscv++) {
  3281.         /*
  3282.          * This is a little tricky.  We only want to add the symbol if we
  3283.          * didn't add it in the lexer.  Otherwise we get duplicate strict
  3284.          * warnings.  But if we didn't add it in the lexer, we must at
  3285.          * least pretend like we wanted to add it even if it existed before,
  3286.          * or we get possible typo warnings.  OPpCONST_ENTERED says
  3287.          * whether the lexer already added THIS instance of this symbol.
  3288.          */
  3289.         gv = gv_fetchpv(SvPVx(kid->op_sv, na),
  3290.         iscv | !(kid->op_private & OPpCONST_ENTERED),
  3291.         iscv
  3292.             ? SVt_PVCV
  3293.             : op->op_type == OP_RV2SV
  3294.             ? SVt_PV
  3295.             : op->op_type == OP_RV2AV
  3296.                 ? SVt_PVAV
  3297.                 : op->op_type == OP_RV2HV
  3298.                 ? SVt_PVHV
  3299.                 : SVt_PVGV);
  3300.     }
  3301.     SvREFCNT_dec(kid->op_sv);
  3302.     kid->op_sv = SvREFCNT_inc(gv);
  3303.     }
  3304.     return op;
  3305. }
  3306.  
  3307. OP *
  3308. ck_formline(op)
  3309. OP *op;
  3310. {
  3311.     return ck_fun(op);
  3312. }
  3313.  
  3314. OP *
  3315. ck_ftst(op)
  3316. OP *op;
  3317. {
  3318.     I32 type = op->op_type;
  3319.  
  3320.     if (op->op_flags & OPf_REF)
  3321.     return op;
  3322.  
  3323.     if (op->op_flags & OPf_KIDS) {
  3324.     SVOP *kid = (SVOP*)cUNOP->op_first;
  3325.  
  3326.     if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
  3327.         OP *newop = newGVOP(type, OPf_REF,
  3328.         gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
  3329.         op_free(op);
  3330.         return newop;
  3331.     }
  3332.     }
  3333.     else {
  3334.     op_free(op);
  3335.     if (type == OP_FTTTY)
  3336.         return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
  3337.                 SVt_PVIO));
  3338.     else
  3339.         return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
  3340.     }
  3341.     return op;
  3342. }
  3343.  
  3344. OP *
  3345. ck_fun(op)
  3346. OP *op;
  3347. {
  3348.     register OP *kid;
  3349.     OP **tokid;
  3350.     OP *sibl;
  3351.     I32 numargs = 0;
  3352.     int type = op->op_type;
  3353.     register I32 oa = opargs[type] >> OASHIFT;
  3354.     
  3355.     if (op->op_flags & OPf_STACKED) {
  3356.     if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
  3357.         oa &= ~OA_OPTIONAL;
  3358.     else
  3359.         return no_fh_allowed(op);
  3360.     }
  3361.  
  3362.     if (op->op_flags & OPf_KIDS) {
  3363.     tokid = &cLISTOP->op_first;
  3364.     kid = cLISTOP->op_first;
  3365.     if (kid->op_type == OP_PUSHMARK ||
  3366.         kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
  3367.     {
  3368.         tokid = &kid->op_sibling;
  3369.         kid = kid->op_sibling;
  3370.     }
  3371.     if (!kid && opargs[type] & OA_DEFGV)
  3372.         *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
  3373.  
  3374.     while (oa && kid) {
  3375.         numargs++;
  3376.         sibl = kid->op_sibling;
  3377.         switch (oa & 7) {
  3378.         case OA_SCALAR:
  3379.         scalar(kid);
  3380.         break;
  3381.         case OA_LIST:
  3382.         if (oa < 16) {
  3383.             kid = 0;
  3384.             continue;
  3385.         }
  3386.         else
  3387.             list(kid);
  3388.         break;
  3389.         case OA_AVREF:
  3390.         if (kid->op_type == OP_CONST &&
  3391.           (kid->op_private & OPpCONST_BARE)) {
  3392.             char *name = SvPVx(((SVOP*)kid)->op_sv, na);
  3393.             OP *newop = newAVREF(newGVOP(OP_GV, 0,
  3394.             gv_fetchpv(name, TRUE, SVt_PVAV) ));
  3395.             if (dowarn)
  3396.             warn("Array @%s missing the @ in argument %d of %s()",
  3397.                 name, numargs, op_name[type]);
  3398.             op_free(kid);
  3399.             kid = newop;
  3400.             kid->op_sibling = sibl;
  3401.             *tokid = kid;
  3402.         }
  3403.         else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
  3404.             bad_type(numargs, "array", op, kid);
  3405.         mod(kid, type);
  3406.         break;
  3407.         case OA_HVREF:
  3408.         if (kid->op_type == OP_CONST &&
  3409.           (kid->op_private & OPpCONST_BARE)) {
  3410.             char *name = SvPVx(((SVOP*)kid)->op_sv, na);
  3411.             OP *newop = newHVREF(newGVOP(OP_GV, 0,
  3412.             gv_fetchpv(name, TRUE, SVt_PVHV) ));
  3413.             if (dowarn)
  3414.             warn("Hash %%%s missing the %% in argument %d of %s()",
  3415.                 name, numargs, op_name[type]);
  3416.             op_free(kid);
  3417.             kid = newop;
  3418.             kid->op_sibling = sibl;
  3419.             *tokid = kid;
  3420.         }
  3421.         else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
  3422.             bad_type(numargs, "hash", op, kid);
  3423.         mod(kid, type);
  3424.         break;
  3425.         case OA_CVREF:
  3426.         {
  3427.             OP *newop = newUNOP(OP_NULL, 0, kid);
  3428.             kid->op_sibling = 0;
  3429.             linklist(kid);
  3430.             newop->op_next = newop;
  3431.             kid = newop;
  3432.             kid->op_sibling = sibl;
  3433.             *tokid = kid;
  3434.         }
  3435.         break;
  3436.         case OA_FILEREF:
  3437.         if (kid->op_type != OP_GV) {
  3438.             if (kid->op_type == OP_CONST &&
  3439.               (kid->op_private & OPpCONST_BARE)) {
  3440.             OP *newop = newGVOP(OP_GV, 0,
  3441.                 gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
  3442.                     SVt_PVIO) );
  3443.             op_free(kid);
  3444.             kid = newop;
  3445.             }
  3446.             else {
  3447.             kid->op_sibling = 0;
  3448.             kid = newUNOP(OP_RV2GV, 0, scalar(kid));
  3449.             }
  3450.             kid->op_sibling = sibl;
  3451.             *tokid = kid;
  3452.         }
  3453.         scalar(kid);
  3454.         break;
  3455.         case OA_SCALARREF:
  3456.         mod(scalar(kid), type);
  3457.         break;
  3458.         }
  3459.         oa >>= 4;
  3460.         tokid = &kid->op_sibling;
  3461.         kid = kid->op_sibling;
  3462.     }
  3463.     op->op_private = numargs;
  3464.     if (kid)
  3465.         return too_many_arguments(op);
  3466.     listkids(op);
  3467.     }
  3468.     else if (opargs[type] & OA_DEFGV) {
  3469.     op_free(op);
  3470.     return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
  3471.     }
  3472.  
  3473.     if (oa) {
  3474.     while (oa & OA_OPTIONAL)
  3475.         oa >>= 4;
  3476.     if (oa && oa != OA_LIST)
  3477.         return too_few_arguments(op);
  3478.     }
  3479.     return op;
  3480. }
  3481.  
  3482. OP *
  3483. ck_glob(op)
  3484. OP *op;
  3485. {
  3486.     GV *gv = newGVgen("main");
  3487.     gv_IOadd(gv);
  3488.     append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
  3489.     scalarkids(op);
  3490.     return ck_fun(op);
  3491. }
  3492.  
  3493. OP *
  3494. ck_grep(op)
  3495. OP *op;
  3496. {
  3497.     LOGOP *gwop;
  3498.     OP *kid;
  3499.     OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
  3500.  
  3501.     op->op_ppaddr = ppaddr[OP_GREPSTART];
  3502.     Newz(1101, gwop, 1, LOGOP);
  3503.     
  3504.     if (op->op_flags & OPf_STACKED) {
  3505.     OP* k;
  3506.     op = ck_sort(op);
  3507.     for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) {
  3508.         kid = k;
  3509.     }
  3510.     kid->op_next = (OP*)gwop;
  3511.     op->op_flags &= ~OPf_STACKED;
  3512.     }
  3513.     kid = cLISTOP->op_first->op_sibling;
  3514.     if (type == OP_MAPWHILE)
  3515.     list(kid);
  3516.     else
  3517.     scalar(kid);
  3518.     op = ck_fun(op);
  3519.     if (error_count)
  3520.     return op;
  3521.     kid = cLISTOP->op_first->op_sibling; 
  3522.     if (kid->op_type != OP_NULL)
  3523.     croak("panic: ck_grep");
  3524.     kid = kUNOP->op_first;
  3525.  
  3526.     gwop->op_type = type;
  3527.     gwop->op_ppaddr = ppaddr[type];
  3528.     gwop->op_first = listkids(op);
  3529.     gwop->op_flags |= OPf_KIDS;
  3530.     gwop->op_private = 1;
  3531.     gwop->op_other = LINKLIST(kid);
  3532.     gwop->op_targ = pad_alloc(type, SVs_PADTMP);
  3533.     kid->op_next = (OP*)gwop;
  3534.  
  3535.     kid = cLISTOP->op_first->op_sibling;
  3536.     if (!kid || !kid->op_sibling)
  3537.     return too_few_arguments(op);
  3538.     for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
  3539.     mod(kid, OP_GREPSTART);
  3540.  
  3541.     return (OP*)gwop;
  3542. }
  3543.  
  3544. OP *
  3545. ck_index(op)
  3546. OP *op;
  3547. {
  3548.     if (op->op_flags & OPf_KIDS) {
  3549.     OP *kid = cLISTOP->op_first->op_sibling;    /* get past pushmark */
  3550.     if (kid && kid->op_type == OP_CONST)
  3551.         fbm_compile(((SVOP*)kid)->op_sv, 0);
  3552.     }
  3553.     return ck_fun(op);
  3554. }
  3555.  
  3556. OP *
  3557. ck_lengthconst(op)
  3558. OP *op;
  3559. {
  3560.     /* XXX length optimization goes here */
  3561.     return ck_fun(op);
  3562. }
  3563.  
  3564. OP *
  3565. ck_lfun(op)
  3566. OP *op;
  3567. {
  3568.     return modkids(ck_fun(op), op->op_type);
  3569. }
  3570.  
  3571. OP *
  3572. ck_rfun(op)
  3573. OP *op;
  3574. {
  3575.     return refkids(ck_fun(op), op->op_type);
  3576. }
  3577.  
  3578. OP *
  3579. ck_listiob(op)
  3580. OP *op;
  3581. {
  3582.     register OP *kid;
  3583.     
  3584.     kid = cLISTOP->op_first;
  3585.     if (!kid) {
  3586.     op = force_list(op);
  3587.     kid = cLISTOP->op_first;
  3588.     }
  3589.     if (kid->op_type == OP_PUSHMARK)
  3590.     kid = kid->op_sibling;
  3591.     if (kid && op->op_flags & OPf_STACKED)
  3592.     kid = kid->op_sibling;
  3593.     else if (kid && !kid->op_sibling) {        /* print HANDLE; */
  3594.     if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
  3595.         op->op_flags |= OPf_STACKED;    /* make it a filehandle */
  3596.         kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
  3597.         cLISTOP->op_first->op_sibling = kid;
  3598.         cLISTOP->op_last = kid;
  3599.         kid = kid->op_sibling;
  3600.     }
  3601.     }
  3602.     
  3603.     if (!kid)
  3604.     append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
  3605.  
  3606.     return listkids(op);
  3607. }
  3608.  
  3609. OP *
  3610. ck_match(op)
  3611. OP *op;
  3612. {
  3613.     cPMOP->op_pmflags |= PMf_RUNTIME;
  3614.     return op;
  3615. }
  3616.  
  3617. OP *
  3618. ck_null(op)
  3619. OP *op;
  3620. {
  3621.     return op;
  3622. }
  3623.  
  3624. OP *
  3625. ck_repeat(op)
  3626. OP *op;
  3627. {
  3628.     if (cBINOP->op_first->op_flags & OPf_PARENS) {
  3629.     op->op_private = OPpREPEAT_DOLIST;
  3630.     cBINOP->op_first = force_list(cBINOP->op_first);
  3631.     }
  3632.     else
  3633.     scalar(op);
  3634.     return op;
  3635. }
  3636.  
  3637. OP *
  3638. ck_require(op)
  3639. OP *op;
  3640. {
  3641.     if (op->op_flags & OPf_KIDS) {    /* Shall we supply missing .pm? */
  3642.     SVOP *kid = (SVOP*)cUNOP->op_first;
  3643.  
  3644.     if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
  3645.         char *s;
  3646.         for (s = SvPVX(kid->op_sv); *s; s++) {
  3647.         if (*s == ':' && s[1] == ':') {
  3648.             *s = '/';
  3649.             Move(s+2, s+1, strlen(s+2)+1, char);
  3650.             --SvCUR(kid->op_sv);
  3651.         }
  3652.         }
  3653.         sv_catpvn(kid->op_sv, ".pm", 3);
  3654.     }
  3655.     }
  3656.     return ck_fun(op);
  3657. }
  3658.  
  3659. OP *
  3660. ck_retarget(op)
  3661. OP *op;
  3662. {
  3663.     croak("NOT IMPL LINE %d",__LINE__);
  3664.     /* STUB */
  3665.     return op;
  3666. }
  3667.  
  3668. OP *
  3669. ck_select(op)
  3670. OP *op;
  3671. {
  3672.     if (op->op_flags & OPf_KIDS) {
  3673.     OP *kid = cLISTOP->op_first->op_sibling;    /* get past pushmark */
  3674.     if (kid && kid->op_sibling) {
  3675.         op->op_type = OP_SSELECT;
  3676.         op->op_ppaddr = ppaddr[OP_SSELECT];
  3677.         op = ck_fun(op);
  3678.         return fold_constants(op);
  3679.     }
  3680.     }
  3681.     return ck_fun(op);
  3682. }
  3683.  
  3684. OP *
  3685. ck_shift(op)
  3686. OP *op;
  3687. {
  3688.     I32 type = op->op_type;
  3689.  
  3690.     if (!(op->op_flags & OPf_KIDS)) {
  3691.     op_free(op);
  3692.     return newUNOP(type, 0,
  3693.         scalar(newUNOP(OP_RV2AV, 0,
  3694.         scalar(newGVOP(OP_GV, 0,
  3695.             gv_fetchpv((subline ? "_" : "ARGV"), TRUE, SVt_PVAV) )))));
  3696.     }
  3697.     return scalar(modkids(ck_fun(op), type));
  3698. }
  3699.  
  3700. OP *
  3701. ck_sort(op)
  3702. OP *op;
  3703. {
  3704.     if (op->op_flags & OPf_STACKED) {
  3705.     OP *kid = cLISTOP->op_first->op_sibling;    /* get past pushmark */
  3706.     OP *k;
  3707.     kid = kUNOP->op_first;                /* get past rv2gv */
  3708.  
  3709.     if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
  3710.         linklist(kid);
  3711.         if (kid->op_type == OP_SCOPE) {
  3712.         k = kid->op_next;
  3713.         kid->op_next = 0;
  3714.         }
  3715.         else if (kid->op_type == OP_LEAVE) {
  3716.         if (op->op_type == OP_SORT) {
  3717.             null(kid);            /* wipe out leave */
  3718.             kid->op_next = kid;
  3719.  
  3720.             for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
  3721.             if (k->op_next == kid)
  3722.                 k->op_next = 0;
  3723.             }
  3724.         }
  3725.         else
  3726.             kid->op_next = 0;        /* just disconnect the leave */
  3727.         k = kLISTOP->op_first;
  3728.         }
  3729.         peep(k);
  3730.  
  3731.         kid = cLISTOP->op_first->op_sibling;    /* get past pushmark */
  3732.         null(kid);                    /* wipe out rv2gv */
  3733.         if (op->op_type == OP_SORT)
  3734.         kid->op_next = kid;
  3735.         else
  3736.         kid->op_next = k;
  3737.         op->op_flags |= OPf_SPECIAL;
  3738.     }
  3739.     }
  3740.     return op;
  3741. }
  3742.  
  3743. OP *
  3744. ck_split(op)
  3745. OP *op;
  3746. {
  3747.     register OP *kid;
  3748.     PMOP* pm;
  3749.     
  3750.     if (op->op_flags & OPf_STACKED)
  3751.     return no_fh_allowed(op);
  3752.  
  3753.     kid = cLISTOP->op_first;
  3754.     if (kid->op_type != OP_NULL)
  3755.     croak("panic: ck_split");
  3756.     kid = kid->op_sibling;
  3757.     op_free(cLISTOP->op_first);
  3758.     cLISTOP->op_first = kid;
  3759.     if (!kid) {
  3760.     cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
  3761.     cLISTOP->op_last = kid; /* There was only one element previously */
  3762.     }
  3763.  
  3764.     if (kid->op_type != OP_MATCH) {
  3765.     OP *sibl = kid->op_sibling;
  3766.     kid->op_sibling = 0;
  3767.     kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
  3768.     if (cLISTOP->op_first == cLISTOP->op_last)
  3769.         cLISTOP->op_last = kid;
  3770.     cLISTOP->op_first = kid;
  3771.     kid->op_sibling = sibl;
  3772.     }
  3773.     pm = (PMOP*)kid;
  3774.     if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
  3775.     SvREFCNT_dec(pm->op_pmshort);    /* can't use substring to optimize */
  3776.     pm->op_pmshort = 0;
  3777.     }
  3778.  
  3779.     kid->op_type = OP_PUSHRE;
  3780.     kid->op_ppaddr = ppaddr[OP_PUSHRE];
  3781.     scalar(kid);
  3782.  
  3783.     if (!kid->op_sibling)
  3784.     append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
  3785.  
  3786.     kid = kid->op_sibling;
  3787.     scalar(kid);
  3788.  
  3789.     if (!kid->op_sibling)
  3790.     append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
  3791.  
  3792.     kid = kid->op_sibling;
  3793.     scalar(kid);
  3794.  
  3795.     if (kid->op_sibling)
  3796.     return too_many_arguments(op);
  3797.  
  3798.     return op;
  3799. }
  3800.  
  3801. OP *
  3802. ck_subr(op)
  3803. OP *op;
  3804. {
  3805.     OP *o = ((cUNOP->op_first->op_sibling)
  3806.          ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first->op_sibling;
  3807.  
  3808.     if (o->op_type == OP_RV2CV)
  3809.     null(o);        /* disable rv2cv */
  3810.     op->op_private = (hints & HINT_STRICT_REFS);
  3811.     if (perldb && curstash != debstash)
  3812.     op->op_private |= OPpDEREF_DB;
  3813.     while (o = o->op_sibling)
  3814.     mod(o, OP_ENTERSUB);
  3815.     return op;
  3816. }
  3817.  
  3818. OP *
  3819. ck_svconst(op)
  3820. OP *op;
  3821. {
  3822.     SvREADONLY_on(cSVOP->op_sv);
  3823.     return op;
  3824. }
  3825.  
  3826. OP *
  3827. ck_trunc(op)
  3828. OP *op;
  3829. {
  3830.     if (op->op_flags & OPf_KIDS) {
  3831.     SVOP *kid = (SVOP*)cUNOP->op_first;
  3832.  
  3833.     if (kid->op_type == OP_NULL)
  3834.         kid = (SVOP*)kid->op_sibling;
  3835.     if (kid &&
  3836.       kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
  3837.         op->op_flags |= OPf_SPECIAL;
  3838.     }
  3839.     return ck_fun(op);
  3840. }
  3841.  
  3842. /* A peephole optimizer.  We visit the ops in the order they're to execute. */
  3843.  
  3844. void
  3845. peep(o)
  3846. register OP* o;
  3847. {
  3848.     register OP* oldop = 0;
  3849.     if (!o || o->op_seq)
  3850.     return;
  3851.     ENTER;
  3852.     SAVESPTR(op);
  3853.     SAVESPTR(curcop);
  3854.     for (; o; o = o->op_next) {
  3855.     if (o->op_seq)
  3856.         break;
  3857.     op = o;
  3858.     switch (o->op_type) {
  3859.     case OP_NEXTSTATE:
  3860.     case OP_DBSTATE:
  3861.         curcop = ((COP*)o);        /* for warnings */
  3862.         o->op_seq = ++op_seqmax;
  3863.         break;
  3864.  
  3865.     case OP_CONCAT:
  3866.     case OP_CONST:
  3867.     case OP_JOIN:
  3868.     case OP_UC:
  3869.     case OP_UCFIRST:
  3870.     case OP_LC:
  3871.     case OP_LCFIRST:
  3872.     case OP_QUOTEMETA:
  3873.         if (o->op_next->op_type == OP_STRINGIFY)
  3874.         null(o->op_next);
  3875.         o->op_seq = ++op_seqmax;
  3876.         break;
  3877.     case OP_STUB:
  3878.         if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) {
  3879.         o->op_seq = ++op_seqmax;
  3880.         break;    /* Scalar stub must produce undef.  List stub is noop */
  3881.         }
  3882.         goto nothin;
  3883.     case OP_NULL:
  3884.         if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
  3885.         curcop = ((COP*)op);
  3886.         goto nothin;
  3887.     case OP_SCALAR:
  3888.     case OP_LINESEQ:
  3889.     case OP_SCOPE:
  3890.       nothin:
  3891.         if (oldop && o->op_next) {
  3892.         oldop->op_next = o->op_next;
  3893.         continue;
  3894.         }
  3895.         o->op_seq = ++op_seqmax;
  3896.         break;
  3897.  
  3898.     case OP_GV:
  3899.         if (o->op_next->op_type == OP_RV2SV) {
  3900.         if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) {
  3901.             null(o->op_next);
  3902.             o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
  3903.             o->op_next = o->op_next->op_next;
  3904.             o->op_type = OP_GVSV;
  3905.             o->op_ppaddr = ppaddr[OP_GVSV];
  3906.         }
  3907.         }
  3908.         else if (o->op_next->op_type == OP_RV2AV) {
  3909.         OP* pop = o->op_next->op_next;
  3910.         IV i;
  3911.         if (pop->op_type == OP_CONST &&
  3912.             (op = pop->op_next) &&
  3913.             pop->op_next->op_type == OP_AELEM &&
  3914.             !(pop->op_next->op_private &
  3915.             (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) &&
  3916.             (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
  3917.                 <= 255 &&
  3918.             i >= 0)
  3919.         {
  3920.             SvREFCNT_dec(((SVOP*)pop)->op_sv);
  3921.             null(o->op_next);
  3922.             null(pop->op_next);
  3923.             null(pop);
  3924.             o->op_flags |= pop->op_next->op_flags & OPf_MOD;
  3925.             o->op_next = pop->op_next->op_next;
  3926.             o->op_type = OP_AELEMFAST;
  3927.             o->op_ppaddr = ppaddr[OP_AELEMFAST];
  3928.             o->op_private = (U8)i;
  3929.             GvAVn((GV*)(((SVOP*)o)->op_sv));
  3930.         }
  3931.         }
  3932.         o->op_seq = ++op_seqmax;
  3933.         break;
  3934.  
  3935.     case OP_MAPWHILE:
  3936.     case OP_GREPWHILE:
  3937.     case OP_AND:
  3938.     case OP_OR:
  3939.         o->op_seq = ++op_seqmax;
  3940.         peep(cLOGOP->op_other);
  3941.         break;
  3942.  
  3943.     case OP_COND_EXPR:
  3944.         o->op_seq = ++op_seqmax;
  3945.         peep(cCONDOP->op_true);
  3946.         peep(cCONDOP->op_false);
  3947.         break;
  3948.  
  3949.     case OP_ENTERLOOP:
  3950.         o->op_seq = ++op_seqmax;
  3951.         peep(cLOOP->op_redoop);
  3952.         peep(cLOOP->op_nextop);
  3953.         peep(cLOOP->op_lastop);
  3954.         break;
  3955.  
  3956.     case OP_MATCH:
  3957.     case OP_SUBST:
  3958.         o->op_seq = ++op_seqmax;
  3959.         peep(cPMOP->op_pmreplstart);
  3960.         break;
  3961.  
  3962.     case OP_EXEC:
  3963.         o->op_seq = ++op_seqmax;
  3964.         if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
  3965.         if (o->op_next->op_sibling &&
  3966.             o->op_next->op_sibling->op_type != OP_DIE) {
  3967.             line_t oldline = curcop->cop_line;
  3968.  
  3969.             curcop->cop_line = ((COP*)o->op_next)->cop_line;
  3970.             warn("Statement unlikely to be reached");
  3971.             warn("(Maybe you meant system() when you said exec()?)\n");
  3972.             curcop->cop_line = oldline;
  3973.         }
  3974.         }
  3975.         break;
  3976.     default:
  3977.         o->op_seq = ++op_seqmax;
  3978.         break;
  3979.     }
  3980.     oldop = o;
  3981.     }
  3982.     LEAVE;
  3983. }
  3984.